Some simple code below. I think I'm having trouble with referencing and looping within a loop.
I'd like to count the number of green cells in a row,then move to the next row. I'm getting an error here:
If RowRange.DisplayFormat.Interior.colour = SourceColour.DisplayFormat.Interior.colour Then
Run-time error 91 - object not set....
Any ideas?
Full code:
Sub countcolourloop1()
Dim rng As Range
Dim RowRange As Range
Dim SourceColour As Range
Dim xBackColour As Integer
'count green cells
Set SourceColour = ActiveWorkbook.ActiveSheet.Range("BN2:BN2")
'cyle through each row, add 1 to the counter xBackColour every time you find a cell in the range matching the SourceColour
For I = 4 To 300
Set RowRange = ActiveWorkbook.ActiveSheet.Range("B" & I & ":BK" & I)
If RowRange.DisplayFormat.Interior.colour = SourceColour.DisplayFormat.Interior.colour Then
xBackColour = xBackColour + 1
End If
Next
End Sub
Related
Suppose that I have Excel file consists of four worksheets, lets name them as 1, 2, 3 and 4. I want to evaluate a sum of all values from the cells AK10, AK25, AK40 and so on till AK160 on the worksheet 4 and then place it in the cell G23 of worksheet 2.
Here is my macro that I assign to worksheet 2:
Sub sum_up()
Dim i As Integer, s As Integer
s = 0
For i = 0 To 10
s = WorksheetFunction.Sum(s, Worksheets("4").Range("AK(10 + 15 * i)"))
Next i
Range("G23").Value = "s"
End Sub
It ends up with 400 error. What am I doing wrong?
Sub sum_up()
Dim i As Long, s As Long
s = 0
For i = 0 To 10
s = s + Worksheets("4").Cells(10 + 15 * i, "AK").Value
Next i
Range("G23").Value = s
End Sub
I'll take a crack at this - I'd really use a lot more named ranged to pass data back and forth...:
Sub sum_up()
Dim i As Integer, s As Integer
s = 0
For i = 0 To 10
s = s + Worksheets("4").Range("AK" & (10 + 15 * i))
Next I
Range("G23").Value = s
End Sub
you did not say that the summation was to be done using VBA
put this in G23 on worksheet2 (actually, put this in any cell)
=SUM('4'!AK10,'4'!AK25,'4'!AK40,'4'!AK55,'4'!AK70,'4'!AK85,'4'!AK100,'4'!AK115,'4'!AK130,'4'!AK145,'4'!AK160)
as far as what you are doing wrong with your code, that has partly been answered by #KenWhite
you are also putting the letter "s" into G23 of any worksheet that happens to be visible at the time your code runs
put in a reference to sheet 2, same as you referenced sheet 4 just two lines above
this code should work:
Sub sum_up()
Dim ws4 As Worksheet
Set ws4 = ActiveWorkbook.Sheets("4")
Dim rng As Range
Set rng = ws4.Range("ak10") ' point to "ak10"
Dim total As Long
total = rng.Value
Do While True
rng.Select
Set rng = rng.Offset(15) ' move pointer down 15 rows
If rng.Row > 160 Then Exit Do ' moved past row 160 ?
total = total + rng.Value
Loop
ActiveWorkbook.Sheets("2").Range("G23").Value = total
End Sub
I have solved this problem myself thanks to the people who offered help
I have an if statement which relies on a counter, I am taking the value of the counter from cell "B3" and the code works fine as it is.
However each time I loop through the program I need the counter to take it's value from a different cell.
so for example loop 1 read value from "B3"
loop 2 read value from "C3"
next "D3" and so on across the sheet
keep going until it reaches a an empty cell
I have dim c as integer
and for c= 2 to 26 to take me to the 26th column
but I am not sure how to get it to increment each time the loop starts. can anyone help with this? I can post the full code I am using at the moment if that will help the understanding of the question
Public Sub copyX()
Dim listofcells As Range
Dim currentname As String
Dim foundrow As Integer
Dim foundcolumn As Integer
Dim counter As Integer
Dim i As Integer
Dim c As Integer
For i = 2 To 26
Sheets("Availability").Activate
counter = Range("b3")
Sheets("Availability").Range("a2").Select
If Not Sheets("Availability").Cells(2, i) = "" Then
Sheets("Availability").Range(Cells(2, i), Cells(2, i).End(xlDown)).Select
Else
GoTo skip: 'If the column has no data then skip to next column
End If
Set listofcells = Selection
Sheets("allocation").Activate
Range("a2").Select
For Each singlecell In listofcells
If counter > 0 Then
If singlecell = "Available" Then
foundcolumn = singlecell.Column 'record the column number where "Available" was found
currentname = Sheets("availability").Range("A" & singlecell.Row) 'record the name of the person in the row where "Available" was found
Set foundName = Sheets("allocation").Range("A:A").Find(What:=currentname, LookIn:=xlValues) 'find the persons name in "Allocation" sheet
foundrow = foundName.Row
Sheets("allocation").Cells(foundrow, foundcolumn) = "X" 'place yes in the same cell as it appeared in "Availability" sheet
counter = counter - 1
End If
End If
Next singlecell
skip:
Next i
End Sub
I have come up with the following code which does go through the cells and get their value, the problem is I can not get a for next loop to work inside another for next loop.
Set counterrange = Range("b3:Z3")
For Each cell In counterrange
Next cell
Try with this concept ...
modify your code to
Dim k as Integer
k=3;
counter =Range(Cells(3, k), Cells(3, k)).Value // through this you will get dynamic counter value like B3,D3,E3.,,,,
if(counter !="")
{
//execute some code
}
k=k+1;
I'm trying to create a macro that uses Index/match functions to match and pull data from one sheet into another. I did it in Excel and it works perfect. However the reports are "dynamic" (the size changes) so I need the last row of my code to be dynamic as well.
The following is what I have done. I'm NOW getting a "type mismatch" error (I emphasize "now" since every time I find a solution for one error another pop's up).
Dim prosheet As Worksheet
Dim prosheet2 As Worksheet
Set prosheet2 = ThisWorkbook.Sheets("shipstation")
Set prosheet = ThisWorkbook.Sheets("macrotestfb")
lr1 = prosheet.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = prosheet2.Cells(Rows.Count, 1).End(xlUp).Row
lrship = prosheet.Cells(Rows.Count, 10).End(xlUp).Row
lrindex = prosheet2.Cells(Rows.Column, 14).End(xlUp).Row
'CALCULATE SHIPPING COST
For x = prosheet.range("j6") To lrship
x = Application.WorksheetFunction.Index(prosheet2.range("a1:n" & lrindex), Application.WorksheetFunction.Match(prosheet.range("a6:a" & lr1), prosheet2.range("a1:a" & lr2), 0), prosheet2.range("f2"))
Next x
Match, in its non array form, only likes one value in the first criterion and not a range.
Also WorksheetFunction.Match will throw an error that will stop the code if a match is not found.
I like to pull the match into its own line and test for the error.
I also adjusted your For statement.
There is no detriment to searching an entire column so I got rid of a few of you last row searches as they are not needed.
Dim prosheet As Worksheet
Dim prosheet2 As Worksheet
Dim x As Long
Dim t As Long
Set prosheet2 = ThisWorkbook.Sheets("shipstation")
Set prosheet = ThisWorkbook.Sheets("macrotestfb")
lrship = prosheet.Cells(Rows.Count, 1).End(xlUp).Row
'CALCULATE SHIPPING COST
For x = 6 To lrship
t = 0
On Error Resume Next
t = Application.WorksheetFunction.Match(prosheet.Range("A" & x), prosheet2.Range("A:A"), 0)
On Error GoTo 0
If t > 0 Then
prosheet.Cells(x, "J").Value = prosheet2.Range("F"&t)
Else
prosheet.Cells(x, "J").Value = "Item does not Exist"
End If
Next x
Note:
Instead of an Index/Match combo which you might use on the worksheet, you can use Application.Match in VBA. Something like this:
Sub GetMatch
Dim indexRng As Range, matchRng as Range
Set indexRng = ThisWorkbook.Worksheets("Sheet1").Range("A1:A10")
Set matchRng = ThisWorkbook.Worksheets("Sheet1").Range("B1:B10")
debug.print indexRng.Cells(Application.Match("something",matchRng,0)).Value
End Sub
Sub UpdateCSAH()
Dim S As String
Dim R As Long
Dim RR As Long
Dim CC As Long
Dim i As Long
Dim j As Long
Dim csah() As String 'an array that stores the CSAH sites
ReDim csah(1 To 100, 1 To 7)
Dim Ran As Range
Dim Ran1 As Range
Set Ran = Worksheets("Current Sites").Range("A1").CurrentRegion 'Ran is the region that has values
RR = 1 'row number in csah
CC = 1 'column number in csah
'check each value in Ran to see if its Route section has "CSAH"
For Each cell In Ran
R = cell.row
S = CStr(Cells(R, 4).value)
If InStr(S, "CSAH") > 0 Then 'check if "CSAH" is in the Route section
If CC > 7 Then 'reset the column number and go to the next row when reach the end of the column
CC = 1
RR = RR + 1
End If
csah(RR, CC) = cell.value
CC = CC + 1
End If
Next cell
Worksheets("CSAH Sites").Select
Range("A2:G100").Select
Selection.ClearContents
'assign each array values to cells in sheet"CSAH Sites"
i = 1
j = 1
For i = 1 To UBound(csah, 1)
For j = 1 To UBound(csah, 2)
Cells(i + 1, j) = csah(i, j)
Next j
Next i
'format the CSAH Sites values
Set Ran1 = Worksheets("CSAH Sites").Range("A1").CurrentRegion
For Each cell In Ran1
If cell.row = 1 Then
With cell.Font
.Color = -11489280
End With
ElseIf cell.row Mod 2 = 0 Then
With cell.Interior
.Color = 10092441
End With
End If
Next cell
End Sub
I have an Excel worksheet named "Current Sites" that has some data. If the 4th column has the word "CSAH", I want to store the values of that row into an array and assign those values to cells in the worksheet named "CSAH Sites". My code sometimes works (the 1st time you click), and most of times it doesn't work or doesn't work properly.
Please help me out! Thanks A Bunch!!
It looks like you want to check every row of data in the "Current Sites" sheet and if column 4 includes the "CSAH" text, then write the first 7 columns of data for that entry to the "CSAH Sites" sheet and add some colour to the even-numbered rows.
To check every row of data, you can read down just one column and use either the Offset or the Cells method to see the values of neighbouring cells. In your code you were "touching" every cell and each time you were then looking at the value in column 4 and also checking to see if the code had gone past column 7. That slows things down a lot and makes the code hard to understand.
You can also assign the values from a range of cells directly to another range of cells without using variables or an array.
See if this does what you want:
Sub UpdateCSAH()
Dim currentSitesRange As Range
Dim thisSiteRange As Range
Dim outputCell As Range
Dim numRowsOfData As Long
Const NUM_COLUMNS_OF_DATA As Integer = 7
Set currentSitesRange = Worksheets("Current Sites").Range("A1")
numRowsOfData = currentSitesRange.CurrentRegion.Rows.Count
Set currentSitesRange = currentSitesRange.Resize(RowSize:=numRowsOfData) 'currentSitesRange is the region that has values
Worksheets("CSAH Sites").Range("A2:G100").ClearContents
Set outputCell = Worksheets("CSAH Sites").Range("A2")
For Each thisSiteRange In currentSitesRange.Cells
' Look for "CSAH" in the Route section (column D)
If InStr(1, thisSiteRange.Offset(ColumnOffset:=3).Value, "CSAH", vbTextCompare) > 0 Then
' Found "CSAH" so write NUM_COLUMNS_OF_DATA columns of data to CSAH Sites sheet
outputCell.Resize(ColumnSize:=NUM_COLUMNS_OF_DATA).Value = thisSiteRange.Resize(ColumnSize:=NUM_COLUMNS_OF_DATA).Value
' Format the even-numbered rows
If outputCell.Row Mod 2 = 0 Then
With outputCell.Resize(ColumnSize:=NUM_COLUMNS_OF_DATA).Interior
.Color = 10092441
End With
End If
Set outputCell = outputCell.Offset(RowOffset:=1)
End If
Next thisSiteRange
End Sub
What I am trying to do is iterate through a range containing worksheet names, and if the cell is not empty then add the result of CountA function to the count variable.
So the count variable should be equal to number of non-blank cells in range B9:B28 on the worksheets I'm iterating through, but strangely the value is equal to the number of non empty cells in the range I'm going through (sheet1!d5:d24).
What am I doing wrong? Here's the code I am using:
For Each c In Worksheets("Sheet1").Range("d5:d24").Cells
If Not IsEmpty(c) Then
count = count + WorksheetFunction.CountA(c & "!b9:b28")
End If
Next
I tried an alternative method to loop through second range and if the cells are not empty, then increment the variable by 1 but that's giving a Run time error 13 type mismatch error. This is what I am doing now:
For Each c In Worksheets("Sheet1").Range("d5:d24")
If Not IsEmpty(c) Then
For Each c2 In Worksheets(c).Range("b9:b28")
If Not IsEmpty(c2) Then
'count = count + WorksheetFunction.CountA(c & "!b9:b28")
count = count + 1
End If
Next
End If
Next
Please help me out. Thanks a lot in advance to all those who take out time to reply.
Based on #Peter Albert and #Peter L. 's comments, finally got it working. The correct code is:
For Each c In Worksheets("Sheet1").Range("d5:d24").Cells
If Not IsEmpty(c.Value) Then
count = count + WorksheetFunction.CountA(c.Value & "!b9:b28")
End If
Next
Thanks a lot guys :)
Try this:
Sub CountColBForColD()
Dim c As Range
Dim r As Long 'row counter
Dim rngB As Range
Dim rngD As Range
Dim lookSheet As Worksheet
Set rngD = Sheets("Sheet1").Range("D5:D24")
Set rngB = Range("B9:B28")
r = 1
For Each c In rngD
If Not IsEmpty(c) Then
On Error GoTo InvalidSheetName
Set lookSheet = Sheets(rngB(r).Value)
On Error GoTo 0
Count = Count + WorksheetFunction.CountA( _
lookSheet.Range(rngB.Address))
c.Offset(0, 1).Value = Count
r = r + 1
End If
NxtC:
Next
Exit Sub
InvalidSheetName:
Err.Clear
MsgBox "Sheet named in " & rngB(r).Address & " does not exist.", vbInformation
Resume NxtC
End Sub