Free Microsoft Excel 2013 Quick Reference

Select non adjacent cell range in vba Results

Hello,

Im trying to create a macro that will do the following. When i record it, it always errors out and doesnt work so im trying to code it manually. Here is an explanation:

I need to Multiply 100 times a range of non-adjacent cells.

ie. the values 0.08125, 0.08000, 0.07875, & 0.07750 are in cells A1,A2,A3,A4 respectively AND 0.07500,0.07625,0.07500,0.07375 are in cells D7,D8,D9,D10.

How can i write a macro that will select all these ranges of cells and multiply the values by 100 so that they end up being 8.125,8.000,7.875,7.750 etc. etc.

Thanks for your help....

I am using code that will copy several formulas in adjacent cells to the end of range; however, when I try to use it to select and copy formulas in non-adjacent cells, I get an error. Tried to modify, but I'm new to VBA...still learning. Here is the code that I currently have.
Thanks for the help.


	VB:
	
 
LastRow = Range("A65536").End(xlUp).Row 
Range("D3").Formula = "=RC[4]/RC[3]" 
Range("F3").Formula = "=RC[-1]*RC[1]" 
Range("J3").Formula = "=RC[-1]/RC[-3]" 
Range("D3,F3,J3").Copy Range("D3,J" & LastRow) 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Good morning, I have been struggling with this project for a week now. I am well versed on Excel with some experience in VBA. What I'm trying to do is copy non-adjacent cells/rows from over 100 different sheets into a new sheet in a summary format. I was able to get this to work initially when only copying specific cells in each sheet. When I tried to look at different fields and their values to determine what data I wanted to copy the code was outside of my experience level. So basically what I want to do is copy the following cells in each sheet if there is no date in the cell range between b12:b2000 on each of the sheets. If there is no data then the only cells I would want to copy and paste across a row are cells B7, B5, H7, H8, B9, C9, D9, K7, K8, P8, Q3, Q5. If there is data in the range of b12:b2000 I would want cells B7, B5, H7, H8, B9, C9, D9, K7, K8, P8, Q3, Q5 and the value to the left of what is found in the b12:b2000 range as well as the next two values to the right of column b. This is the code I have so far.

	VB:
	
 Button1_Click() 
    Dim SiteCol As Range, Cell As Object 
    Dim ws As Worksheet, LR As Integer 
    Application.ScreenUpdating = False 
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "FMS" 
    Set SiteCol = Range("b12:b2000") 'Range containing values
    For Each ws In ThisWorkbook.Worksheets 
        For Each Cell In SiteCol 
            With ws 
                If IsEmpty(Cell) Then 
                    .Range("B7").Copy 
                    Sheets("FMS").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("B5").Copy 
                    Sheets("FMS").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("H7").Copy 
                    Sheets("FMS").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("H8").Copy 
                    Sheets("FMS").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("B9").Copy 
                    Sheets("FMS").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("C9").Copy 
                    Sheets("FMS").Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("D9").Copy 
                    Sheets("FMS").Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("K7").Copy 
                    Sheets("FMS").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("K8").Copy 
                    Sheets("FMS").Range("I" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("P8").Copy 
                    Sheets("FMS").Range("J" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("Q3").Copy 
                    Sheets("FMS").Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("Q5").Copy 
                    Sheets("FMS").Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                End If 
                If Cell.Value > "0" Then 
                    .Range("B7").Copy 
                    Sheets("FMS").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("B5").Copy 
                    Sheets("FMS").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("H7").Copy 
                    Sheets("FMS").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("H8").Copy 
                    Sheets("FMS").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("B9").Copy 
                    Sheets("FMS").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("C9").Copy 
                    Sheets("FMS").Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("D9").Copy 
                    Sheets("FMS").Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("K7").Copy 
                    Sheets("FMS").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("K8").Copy 
                    Sheets("FMS").Range("I" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("P8").Copy 
                    Sheets("FMS").Range("J" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("Q3").Copy 
                    Sheets("FMS").Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    .Range("Q5").Copy 
                    Sheets("FMS").Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
Paste:=xlPasteValuesAndNumberFormats 
                    Selection.Value = Cells(Cell.Row, 13).Value 
                End If 
            End With 
        Next 
        With Worksheets("FMS") 
            On Error Resume Next 
            .Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
            On Error Goto 0 
            LR = .Range("A" & Rows.Count).End(xlUp).Row 
            .Range("A1:B" & LR).Sort Key1:=Range("A1"), Order1:=xlAscending, _ 
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 
        End With 
        Application.CutCopyMode = False 
        Application.ScreenUpdating = True 
    Next ws 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Any help with this would be greatly appreciated.

Is it possible to set a sheet scroll area to non-adjacent ranges?

For instance I have an Index sheet to set up hyperlinks to multiple worksheets in the same workbook
Option Explicit

Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim l As Long
    shIndex.Unprotect
    l = 1
    With Me
        .Columns(1).ClearContents
        .Cells(1, 1) = "SHEET INDEX"
        .Cells(1, 1).Name = "Index"
    End With
    For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name Then
            l = l + 1
            With wSheet
                .Range("A1").Name = "Start" & wSheet.Index
                .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", SubAddress:="Index",
TextToDisplay:="Switchboard"
            End With
            Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", SubAddress:="Start" &
wSheet.Index, TextToDisplay:=wSheet.Name
        End If
    Next wSheet
    shIndex.Protect UserInterfaceOnly:=True
End Sub
This also establishes a hyperlink in cell A1 on all of the other sheets to return to the Index tab.

What I want to do is set each worksheet's scroll area to the data entry area, plus cell A1.

Example: The data input area, of a particular sheet, might be C3:H100 so I would like to set the scroll area to that range, but also allow for selecting cell A1 to hyperlink back to the Index sheet. The VBA help only gives using text in the A1 notation.

I have tried to manually enter
 but I get an invalid property error.

Good evening,

I am essentially trying to populate 2 comboboxes where the first is dependent on the second. The first is populated with unique values from a dynamic range on a particular sheet. Upon selection in the first combobox, I need the second combobox to be populated with the value of the cell in the one column to the right. My first combobox is populated using the unique values from column C, and I need the value of the cell in the same row in column D. Ideally, I would like only unique values to appear in this combobox also.

Here is the code I'm working with:


	VB:
	
 UserForm_Initialize() 
    Dim DisciplineRange As Range, DisciplineName As Range 
    Dim NoDupesDiscipline As New Collection 
    Dim wbWorkbook As Workbook 
    Dim wsSheet As Worksheet 
    Dim DisciplineAddress As Range 
     
     
    Set wbWorkbook = ThisWorkbook 
    Set wsSheet = wbWorkbook.Worksheets("Data Fields") 
    With wsSheet 
        Set DisciplineRange = .Range(.Range("C6"), .Range("C6").End(xlDown)) 
    End With 
     
    On Error Resume Next 
    For Each DisciplineName In DisciplineRange 
        NoDupesDiscipline.Add DisciplineName.Value, CStr(DisciplineName.Value) 
    Next DisciplineName 
    On Error Goto 0 
     
    For Each Item In NoDupesDiscipline 
        addEquip.cbDiscipline.AddItem Item 
    Next Item 
     
     
End Sub 
 
Private Sub cbDiscipline_Change() 
    Dim FilteredEquipRange As New Collection 
    Dim Discipline As String 
    Dim Found As Boolean 
     
    Sheet2.Activate 
    Range("C6").Activate 
    Discipline = cbDiscipline.Value 
    Found = False 
     
    Do Until IsEmpty(ActiveCell) 
        If ActiveCell.Value = Discipline Then 
            Found = True 
            Exit Do 
        End If 
        ActiveCell.Offset(1, 0).Select 
    Loop 
     
    If Found = True Then 
        FilteredEquipRange.Add ActiveCell.Offset(0, 1).Value, CStr(ActiveCell.Offset(0, 1).Value) 
    End If 
     
    For Each Item In FilteredEquipRange 
        addEquip.cbSelectEquip.AddItem Item 
    Next Item 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
For each found = true, I want the value of the cell one column to the right to be stored as a range so I can then extract the unique values to populate the combobox. I want the code to loop through all the values of true, but right now the second box is only populated using the value of the cell one column to the right of the first "True" value of the boolean, but there should be about 5 more values showing in the combobox list. I'm sure there's an easy solution to this, but I am pretty new to VBA and can't see to find the answer anywhere.

Any help would be very much appreciated!!

I have written code that identifies which columns on a tab need to be deleted. However, my macro currently deletes each column at once, at this proves very slow since it is in a massive file. Since I have to do this across 21 tabs, it takes about an hour which is way too long. Assuming I know which columns to delete (say columns 1,3,5, for instance) is there a way I can delete them all at once? The columns will be non-adjacent usually.

Below is my code for identifying which columns to delete (and deletes them at once). No need to peruse it; I'm just attaching it just in case. The code can handle a multiple tab selection as well. Thanks a million!

Jared
Code:
Sub DeleteColumns()
'works on a continuous multitab group
'BEWARE: the activecell's row becomes the row whose values are evaluated
Dim NumberOfTabs: NumberOfTabs = 0
Dim CurColumn%, OrigRow%, CurrentTab%
NumberOfTabs = ActiveWindow.SelectedSheets.Count
OrigRow = ActiveCell.Row

DeleteValue = InputBox("Reminder: Macro will delete ALL columns having specified value in ENTIRE row of active cell." & _
                        vbCrLf & vbCrLf & "What non-numeric value should trigger the column deletion?")

ActiveSheet.Previous.Activate  'deselects the grouped tabs, assuming the current tab is the leftmost tab
ActiveSheet.Next.Activate      'returns macro to original tab


Do  'Loop across tabs
CurColumn = 256


    Do                     'Loops within a tab, starting with the leftmost cell and continuing to the end
        If DeleteValue = Cells(OrigRow, CurColumn).Value Then Columns(CurColumn).Delete
        y = Cells(OrigRow, CurColumn).Value
        CurColumn = CurColumn - 1
    Loop Until CurColumn = 0
        
    CurrentTab = CurrentTab + 1
    If CurrentTab  NumberOfTabs Then ActiveSheet.Next.Select  'advance if still more tabs in originally grouped range
Loop Until CurrentTab = NumberOfTabs
    
End Sub


Hi folks,
I'm baffled- I'm writing a macro to pull a data table into an excel
sheet & create a bargraph of those results. The number of records in
the data table are variable (say between 2 and 50).

I'm trying to define a dynamic bar graph using VBA. The X values are
in col C and the text Y vlaues are in col A. (both start in row 3) The
values in column B are necessary, but have nothing to do with the
graph. I'm having trouble using variables to define the source data as
two, non adjacent ranges.

I've had problems just including the 50 cells in the data table as it
includes blank
spaces in the chart.

The code below builds the graph based on the X values starting in cell
C3. It just numbers them on the Y axis, not by the corresponding text
values....

Any ideas?
Thanks
pim

Dim sheetName as String 'name of the sheet where the data table
Dim NoRec As Double 'Number of records returned in query
Dim Graph As ChartObject 'Bar graph

NoRec = Application.WorksheetFunction.CountA(Columns("A:A" ))
Set Graph = ActiveSheet.ChartObjects.Add _
(Left:=285, Width:=548, Top:=40, Height:=825)
Graph.Chart.SetSourceData
Source:=Sheets(sheetName).Range(Cells(3, 3), Cells(NoRec, 3))

Graph.Chart.ChartType = xlBarClustered
ActiveSheet.ChartObjects(1).Activate

ActiveChart.HasLegend = False
ActiveChart.HasTitle = False
With ActiveChart.ChartGroups(1)
.Overlap = 0
.GapWidth = 140
.HasSeriesLines = False
End With
With ActiveChart.ChartGroups(1)
.Overlap = 0
.GapWidth = 140
.HasSeriesLines = False
End With
'Y axis- text names format
With ActiveChart.Axes(xlCategory)
.CrossesAt = 1
.TickLabelSpacing = 1
.TickMarkSpacing = 1
.AxisBetweenCategories = True
.ReversePlotOrder = True
.MajorTickMark = xlOutside
.MinorTickMark = xlNone
.TickLabelPosition = xlLow
End With
'X axis-PI values Format
With ActiveChart.Axes(xlValue)
.TickLabelPosition = xlHigh
End With
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With

--
Pim
------------------------------------------------------------------------
Pim's Profile: http://www.excelforum.com/member.php...o&userid=27565
View this thread: http://www.excelforum.com/showthread...hreadid=470956

Hi folks,
I'm baffled- I'm writing a macro to pull a data table into an excel sheet & create a bargraph of those results. The number of records in the data table are variable (say between 2 and 50).

I'm trying to define a dynamic bar graph using VBA. The X values are in col C and the text Y vlaues are in col A. (both start in row 3) The values in column B are necessary, but have nothing to do with the graph. I'm having trouble using variables to define the source data as two, non adjacent ranges.

I've had problems just including the 50 cells in the data table as it includes blank
spaces in the chart.

The code below builds the graph based on the X values starting in cell C3. It just numbers them on the Y axis, not by the corresponding text values....

Any ideas?
Thanks
pim

Dim sheetName as String 'name of the sheet where the data table
Dim NoRec As Double 'Number of records returned in query
Dim Graph As ChartObject 'Bar graph

NoRec = Application.WorksheetFunction.CountA(Columns("A:A"))
Set Graph = ActiveSheet.ChartObjects.Add _
(Left:=285, Width:=548, Top:=40, Height:=825)
Graph.Chart.SetSourceData Source:=Sheets(sheetName).Range(Cells(3, 3), Cells(NoRec, 3))

Graph.Chart.ChartType = xlBarClustered
ActiveSheet.ChartObjects(1).Activate

ActiveChart.HasLegend = False
ActiveChart.HasTitle = False
With ActiveChart.ChartGroups(1)
.Overlap = 0
.GapWidth = 140
.HasSeriesLines = False
End With
With ActiveChart.ChartGroups(1)
.Overlap = 0
.GapWidth = 140
.HasSeriesLines = False
End With
'Y axis- text names format
With ActiveChart.Axes(xlCategory)
.CrossesAt = 1
.TickLabelSpacing = 1
.TickMarkSpacing = 1
.AxisBetweenCategories = True
.ReversePlotOrder = True
.MajorTickMark = xlOutside
.MinorTickMark = xlNone
.TickLabelPosition = xlLow
End With
'X axis-PI values Format
With ActiveChart.Axes(xlValue)
.TickLabelPosition = xlHigh
End With
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With

Does anyone know a sneaky way to highlight different values in a single column of unsorted data? VBA or non-VBA answers are welcome.

I've already tried the following:

(1) Advanced filtering for unique records. Works only if the data is sorted, not unsorted.

(2) Conditional formats. Highlights different values in unsorted data, but I'd like to select these different values after they've been highlighted. There doesn't seem to be a way to do this apart from adding a column next to each data column, inserting formulas that flag the different data in the adjacent column, selecting the formula results, and offsetting the selection back to the data column. (http://www.experts-exchange.com/Appl..._21484217.html)

I'd like to avoid looping through rows or cells in the used range, as this will be too slow for my data.

Thanks very much.

I have a data set broken down by day and by half hour on a worksheet. I’m trying to use VBA to select a date/time on this worksheet, and copy some adjacent data, find the same date/time on a different worksheet and paste the data to this worksheet. The end goal is to create a loop so that I can automate pasting data into the correct worksheet with the corresponding date and time.

The problem is that when I try to find the date/time on the 2nd worksheet, the error message tells me the object variable or with block variable not set.
The format of the date/time in both the origin sheet and the destination sheet is the same, and when I hover my mouse over the variable in the code it comes up with the correct date time.

When I go into excel when the code breaks, I look at the find box and the format of the date/time it is supposed to find has changed from “8/05/2008 08:00” to “5/8/2008 8:00:00 AM”. I’m not sure if the AM/PM has caused a problem, or if it is searching for the American date format rather than the NZ date format which has caused the problem.

When i just copy the date/time from the 1st worksheet, and use Find and replace and paste the/date time in it finds the cell perfectly. Its just using Find in code that is a problem.

I'm quite new to VBA so any help would be greatly appreciated.


	VB:
	
 ThirtyMinStatsNewDataWithoutReformat() 
     
    Dim strCallType As String 
    Dim i As Integer 
    Dim dtmDateTimeToFind As Date 
    Dim strSheetToFind As String 
     
    Calculate 
    i = 1 
     
     'postitions cursor for loop below
    Sheets("datasheet").Select 
    Range("b2").Select 
     
     'this cell is sheetname to go to next
    Calculate 
    strSheetToFind = ActiveCell.Text 
     
     'this is is the date/time to find on the destination sheet
    ActiveCell.Offset(0, 2).Select 
    dtmDateTimeToFind = ActiveCell.Value 
     
     'copies cells to be pasted on destination sheet
    ActiveCell.Offset(0, 1).Select 
    ActiveCell.Range(Cells(1, 1), Cells(1, 6)).Copy 
     
    Sheets(i).Activate 
    Sheets(strSheetToFind).Select 
    Columns("B:B").Select 
     
    Cells.Find(What:=dtmDateTimeToFind, After:=ActiveCell, LookIn:= _ 
    xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _ 
    xlNext, MatchCase:=False, SearchFormat:=False).Activate 
    ActiveCell.Offset(0, 7).Select 
    ActiveSheet.Paste 
     
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


All

I am a newbie to using VBA code in Excel, and I'm trying to help my prospective father-in-law1!

He has been collecting data on the location of visitors to a small educational farm in North Carolina, USA, and would like to tabulate the answer to the following question: "In which zip (postal) code do you live?", which he asks all customers when they visit. Looking at the first ~150 answers there are about 25 zip codes that make up the majority of answers. We would like to have these zip codes displayed as buttons on an Excel screen so they can be clicked by non-technical staff.

I have got as far as creating the buttons and getting the cells adjacent to the buttons to count the clicks (see code below). However, I would like to solve the following problems:

1. If the workbook is closed and then reopened, the next time a button is clicked the counter resets to 0. How can I ensure the counter for each button does not reset?

2. I would like the option of saving the totals to another worksheet AND then resetting the counters to 0. How can this be achieved?

I hope you can help me! The current button code is below:


	VB:
	
 Zip27278_Click() 
    Static x As Integer 
    x = x + 1 
    Range("C3").Select 
    ActiveCell.FormulaR1C1 = "" & x & " visitors" 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
BB.


No luck finding an answer? You could always try Google.