I'm creating a tool that pulls in data from SQL and then extracts the data depending on dates and users relating to that data. I need this to work in a large range of users.
I have some code that currently has a nested for loop. Using lastrow variables, it checks to see if the value of a cell and the first loop value - for example .range("b" & R) - equals the value of a cell and the second loop value - .range("H" & i). In this, there's an if statement e.g
If the date in range("E"&r) = the date in range("G"&i) and lcase(range("A" & r) = lcase(range("H" & y) then...
I need the value of y to change to basically say if G&i = H&y or H&y and so on until it gets to the end of my range.
Sub mysub(sheet As String)
Dim i As Long
Dim r As Long
Dim y As Long
Dim lastRow As Long
Dim lastRow2 As Long
Dim hours As Single
Dim lastRow3 As Long
Application.ScreenUpdating = False
Sheets(sheet).Activate
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lastRow2 = ActiveSheet.Range("AD" & Rows.Count).End(xlUp).Row
lastRow3 = Sheets("mysheet").Range("B" & Rows.Count).End(xlUp).Row
For r = 4 To lastRow2
For i = 2 To lastRow
For y = 2 To lastRow3
If ActiveSheet.Range("E" & i).Value = ActiveSheet.Range("AH" & r) And _
LCase(ActiveSheet.Range("A" & i).Value) = LCase(Sheets("agents").Range("B" & y).Value) Then
hours = hours + ActiveSheet.Range("D" & i).Value
End If
Next y
Next i
ActiveSheet.Range("AE" & r).Value = hours
ActiveSheet.Range("AE" & r).NumberFormat = "[h]:mm"
hours = 0
Next r
Application.ScreenUpdating = True
End Sub
Any help on this would be a massive help.
Related
I am new in VBA so i just look for the code online and i modify it for my files.
I would like to know if i can put together the following 2 macros.
It looks for contract number in column AF and then changes the Customer Name (col AN) & Customer Group Name (col AP). can it be donein another way?
I would like to simplify it as later i need, based on Contract Number to change 5 more variables in 5 different columns for other customers.
Sub CorrectCustomerNameXXXX()
Dim LastRow As Long
Dim i As Long
LastRow = Range("AF1000000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("AF" & i) = "006-0146157-001" Then
Range("AN" & i).Value = "CUSTOMER_NAME"
End If
Next
End Sub
Sub CorrectCustomerGROUPNameXXXX()
Dim LastRow As Long
Dim i As Long
LastRow = Range("AF1000000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("AF" & i) = "006-0146157-001" Then
Range("AP" & i).Value = "CUSTOMER_GROUP"
End If
Next
End Sub
Thanks in advance for your help
Try this code, please. You should use the same iteration:
Sub CorrectWhatever()
Dim LastRow As Long, i As Long
LastRow = Range("AF" & rows.count).End(xlUp).Row
For i = 1 To LastRow
If Range("AF" & i).Value = "006-0146157-001" Then
Range("AN" & i).Value = "CUSTOMER_NAME"
Range("AP" & i).Value = "CUSTOMER_GROUP"
End If
Next
End Sub
I have data in B Column of an excel file. I have made a loop that If the value in B Cell is greater than a particular (len1) value, then the code puts the Cell (Value-Len1) value in a new cell at the end of the rows.
I increment the counter as lastrow = lastrow+1 everytime when the row is added. Now here is the problem. Iniitially in the input file I had 122 set of data. But by the time the For loop finishes the value of lastrow becomes 160, but the loop exits at 122. WHY?? Any Help will be appreciated.
For i = 1 To lastrow Step 1
If Range("B" & i).Value > len1 Then
Range("A" & lastrow + 1).Value = Range("A" & i).Value
Range("B" & lastrow + 1).Value = Range("B" & i).Value - len1
Range("B" & i).Value = len1
lastrow = lastrow + 1
End If
Next
To get the behaviour you want you need a while loop (or do loop)
i = 1
While i <= lastrow
If Range("B" & i).Value > len1 Then
lastrow = lastrow + 1
Range("A" & lastrow).Value = Range("A" & i).Value
Range("B" & lastrow).Value = Range("B" & i).Value - len1
Range("B" & i).Value = len1
End If
i = i + 1
Wend
I tested it with the sub below:
Sub LoopBeyondLastRow()
Dim i As Long, lastrow As Long, len1 As Long
len1 = 10
With ThisWorkbook.Sheets("Sheet1")
lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
i = 1
While i <= lastrow
If .Range("B" & i).Value > len1 Then
lastrow = lastrow + 1
.Range("A" & lastrow).Value = .Range("A" & i).Value
.Range("B" & lastrow).Value = .Range("B" & i).Value - len1
.Range("B" & i).Value = len1
End If
i = i + 1
Wend
End With
End Sub
Please note the following:
Inside the loop I incremented lastrow first and then used it in the following 2 statements (to reduce the number of addition operations)
In my test code I added With ThisWorkbook.Sheets("Sheet1") to fully qualify all ranges. Not doing this is the source of many bugs that are sometimes very difficult to pinpoint. One should get in the habbit of never to write Range or Cells without a little . before them.
A faster method would be to export the range values to array and then do the comparision. Store the final output into a temp array and write it back to the worksheet.
If you want to follow your approach then is this what you are trying? I have commented the code so you should not have a problem understanding it. Basically you need 2 loops if you want to recheck the data that you are adding at the end of the row.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim ComparisionValue As Long
Dim countOfMatchedValues As Long
Dim lRow As Long
Dim i As Long
Dim outputRow As Long
Dim rng As Range
'~~> Change this to the relevant sheet
Set ws = Sheet1
'~~> Change this to the relevant
'~~> comparision value
ComparisionValue = 122
With ws
'~~> Start an indefinite loop
Do
'~~> Find last row
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Fix the output row for the new data
outputRow = lRow + 1
'~~> Check if there are any matches for your condition
countOfMatchedValues = Application.WorksheetFunction.CountIf( _
.Range("B1:B" & lRow), ">" & ComparisionValue)
'~~> If not then exit loop
If countOfMatchedValues = 0 Then Exit Do
'~~> Do your stuff
For i = 1 To lRow
If .Range("B" & i).Value > ComparisionValue Then
.Range("A" & outputRow).Value = .Range("A" & i).Value
.Range("B" & outputRow).Value = .Range("B" & i).Value - ComparisionValue
.Range("B" & i).Value = ComparisionValue
outputRow = outputRow + 1
End If
Next i
Loop
End With
End Sub
In Action
for loops use a pre-defined number of iterations. For an unknown number of iterations you need to use a while loop.
Your code uses the value of lastRow at the time it was interpreted, and is never updated again.
This is similar to:
lastRow = 1
Debug.Print lastRow
lastRow = lastRow + 1
Debug.Print lastRow
You will see:
1
2
and not:
2
2
because once the first Debug statement has been executed, changing the value of lastRow doesn't affect this particular output anymore.
Test the next code, please:
Sub TestLoopAddedRowsInclusive()
'..... your code defining LastRow and len1
Dim lastRInit As Long
lastRInit = LastRow
For i = 1 To Rows.count
If Range("B" & i).Value = "" And i >= lastRInit Then Exit For
If Range("B" & i).Value > len1 Then
Range("A" & LastRow + 1).Value = Range("A" & i).Value
Range("B" & LastRow + 1).Value = Range("B" & i).Value - len1
Range("B" & i).Value = len1
LastRow = LastRow + 1
End If
Next
End Sub
I have written a piece of code that does reconciliation:
The first part checks between columns.
Works absolutely fine on upto 100k Rows, then simply freezes on anything bigger. Is the an optimal way to write this? Should I be using a scripting dictionary for the reconciliation too? Ive been off VBA for a while now and I am pretty rusty! Thanks for reading and helping.
Sub AutoRecon()
Worksheets("Main_Recon").Select
Dim i As Long, _
LRa As Long, _
LRb As Long, _
rowx As Long
LRa = Range("A" & Rows.Count).End(xlUp).Row
LRb = Range("G" & Rows.Count).End(xlUp).Row
rowx = 2
Application.ScreenUpdating = False
For i = 2 To LRa
If Range("A" & i).Errors.Item(xlNumberAsText).Value = True Then
Range("A" & i).Value = "N" & Range("A" & i).Value
rowx = rowx + 1
End If
Next i
rowx = 2
For i = 2 To LRb
If Range("G" & i).Errors.Item(xlNumberAsText).Value = True Then
Range("G" & i).Value = "N" & Range("G" & i).Value
rowx = rowx + 1
End If
Next i
rowx = 2
For i = 2 To LRa
If IsError(Application.Match(Range("A" & i).Value, Range("G2:G" & LRb), 0)) Then
Range("O" & rowx).Value = Range("A" & i).Value
rowx = rowx + 1
End If
Next i
rowx = 2
For i = 2 To LRb
If IsError(Application.Match(Range("G" & i).Value, Range("A2:A" & LRa), 0)) Then
Range("S" & rowx).Value = Range("G" & i).Value
rowx = rowx + 1
End If
Next i
Application.ScreenUpdating = True
End Sub
This takes too long.
The issue is that you run the loop 4 times, but you can combine 2 loops.
You can gain some speed in the process using arrays to read/write. Every read/write action to a cell needs a lot of time. So the idea is to read all data cells into an array DataA at once (only 1 read action) then process the data in the array and then write it back to the cells at once (only 1 write action). So if you have 100 rows you save 99 read/write actions.
So you would end up with something like below. Note this is untested, so backup before running this.
Option Explicit
Public Sub AutoRecon()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Main_Recon")
Application.ScreenUpdating = False
'find last rows of columns
Dim LastRowA As Long
LastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim LastRowG As Long
LastRowG = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
'read data into array
Dim DataA() As Variant 'read data from column A into array
DataA = ws.Range("A1", "A" & LastRowA).Value
Dim DataG() As Variant 'read data from column G into array
DataG = ws.Range("G1", "G" & LastRowG).Value
Dim iRow As Long
For iRow = 2 To Application.Max(LastRowA, LastRowG) 'combine loop to the max of both columns
If iRow <= LastRowA Then 'run only until max of column A
If ws.Cells(iRow, "A").Errors.Item(xlNumberAsText).Value = True Then
DataA(iRow, 1) = "N" & DataA(iRow, 1)
End If
End If
If iRow <= LastRowG Then 'run only until max of column G
If ws.Cells(iRow, "G").Errors.Item(xlNumberAsText).Value = True Then
DataG(iRow, 1) = "N" & DataG(iRow, 1)
End If
End If
Next iRow
'write array back to sheet
ws.Range("A1", "A" & LastRowA).Value = DataA
ws.Range("G1", "G" & LastRowG).Value = DataG
'read data into array
Dim DataO() As Variant 'read data from column O into array (max size = column A)
DataO = ws.Range("O1", "O" & LastRowA).Value
Dim DataS() As Variant 'read data from column G into array (max size = column G)
DataS = ws.Range("S1", "S" & LastRowG).Value
Dim oRow As Long, sRow As Long
oRow = 2 'output row start
sRow = 2
For iRow = 2 To Application.Max(LastRowA, LastRowG) 'combine loop to the max of both columns
If iRow <= LastRowA Then
If IsError(Application.Match(DataA(iRow, 1), DataG, 0)) Then
DataO(oRow, 1) = DataA(iRow, 1)
oRow = oRow + 1
End If
End If
If iRow <= LastRowG Then
If IsError(Application.Match(DataG(iRow, 1), DataA, 0)) Then
DataS(sRow, 1) = DataG(iRow, 1)
sRow = sRow + 1
End If
End If
Next iRow
'write array back to sheet
ws.Range("O1", "O" & LastRowA).Value = DataO
ws.Range("S1", "S" & LastRowG).Value = DataS
Application.ScreenUpdating = True
End Sub
I have a sorted list of ID's in Excel. I want to grab all the rows with the same ID, then I'll be manipulating them.
Sub Selectingabox()
Dim I As Integer
Dim N As Integer
'Defining
I = 1
N = 1
'Initializing
While I < 3000
'If I have more than 3k rows I'm in serious trouble anyways
If Range("A" & I).Select = Range("A" & I + 1).Select Then
I = I + 1
Else: Range("A" & N, "AJ" & I).Select
'Lots of stuff manipulating the data range we just selected
N = I + 1
'The new top row
I = I + 1
'The new bottom row
Wend
End Sub
Not quite working.. the wend is unhappy with me, and I'm not sure why. Also have no idea if the code will work!
Couple of things:
dim your values as long rather than integer, so you won't get an error at row 32k
Use a FOR loop rather than a while loop to make your code more efficient
Rather then using number 3000 you can use VBA to find the last row automatically using Cells(Rows.Count, "A").End(xlUp).Row
I would not recommend using .Select in your code. What are you trying to manipulate?
Sub Selectingabox()
Dim I As Long
Dim N As Long
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
N = 1
For I = 1 To lastrow
If I = lastrow Then
If Range("A" & I).Value <> Range("A" & I - 1).Value Then
Range("A" & N & ":AJ" & I).Select
N = I + 1
End If
Else
If Range("A" & I).Value <> Range("A" & I + 1).Value Then
Range("A" & N & ":AJ" & I).Select
'Lots of stuff manipulating the data range we just selected
N = I + 1
End If
End If
Next I
End Sub
Add an End If into your code - that will resolve the Compile Error
Sub Selectingabox()
Dim I As Integer
Dim N As Integer
'Defining
I = 1
N = 1
'Initializing
While I < 3000
'If I have more than 3k rows I'm in serious trouble anyways
If Range("A" & I).Select = Range("A" & I + 1).Select Then
I = I + 1
Else: Range("A" & N, "AJ" & I).Select
'Lots of stuff manipulating the data range we just selected
N = I + 1
'The new top row
I = I + 1
'The new bottom row
End If ' add this here
Wend
End Sub
I have a sheet:
I am trying to write code to be able to combine multiple values into one row, I need to sum the values from columns, B, C and D.
My aim is to be able to press a button and I have all of my duplicate values removed, but before this, the numerical values in the adjacent columns are summed into the single version.
So far I have removed the duplicates from the column:
Sheets("Sheet4").Select
With Columns("A:A")
.Replace What:="mobile", Replacement:=""
End With
Previous code should do your job. It may need a fine tuning but idea would work. Do not forget to make proper addressing of worksheets for your ranges. I did not do it. This will work on the active sheet currently.
Update: Updated with worksheet addresses.
Dim ws As Worksheet
Dim LastRow As Long
Dim S_Value As String
Set ws = Sheets("Sheet1")
LastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 2
While i <= LastRow
S_Value = ws.Range("A" & i).Value
j = i + 1
While j <= LastRow
If ws.Range("A" & j).Value = S_Value Then
ws.Range("B" & i).Value = ws.Range("B" & i).Value + ws.Range("B" & j).Value
ws.Range("C" & i).Value = ws.Range("C" & i).Value + ws.Range("C" & j).Value
ws.Range("D" & i).Value = ws.Range("D" & i).Value + ws.Range("D" & j).Value
ws.Rows(j & ":" & j).EntireRow.Delete
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
j = j - 1
End If
j = j + 1
Wend
i = i + 1
Wend
Here you go,
Sub SumCount()
Dim s, c, sm
Dim Rws As Long, Rng As Range
Rws = Cells(Rows.Count, "B").End(xlUp).Row
Set Rng = Range(Cells(2, 2), Cells(Rws, 4))
s = InputBox("What Number to Find?")
c = Application.WorksheetFunction.CountIf(Rng, s)
sm = s * c
MsgBox sm
End Sub