I'm trying to compare data between two worksheets. Each Worksheet has three column: A is a concatenation of a Customer and a SKU, B is the sales volume and C is for measuring volume discrepancies. I aim to do two things, check Sheet1 for SKUs that are not in Sheet2 and then, if SKUs match on both sheets, check their volume for quantity differences. If Sheet 1 has a SKU not in Sheet2, I want the record highlighted. I've accomplished this in a primitive way, the entire row gets highlighted. I am, however, having trouble getting the code to check volumes if the Customer & SKU match. I was hoping VBA would retain the values of the cells it was checking, where have I gone wrong and what is the proper implementation? Sorry for being such a n00b.
Sub Again()
Dim lastRow As Integer
Dim rng As Range
lastRow = Sheets("Sheet1").Range("A65000").End(xlUp).Row
For i = 1 To lastRow
Set rng = Sheets("sheet2").Range("A:A").Find(Sheets("Sheet1").Cells(i, 1))
If rng Is Nothing Then
Sheets("Sheet1").Cells(i, 3) = "Item not in sheet2"
Sheets("Sheet1").Cells(i, 1).EntireRow.Interior.Color = vbRed
ElseIf Not rng Is Nothing Then
If Sheets("sheet1").Cells(i, 2).Value - Sheets("sheet2").Cells(i, 2).Value < -5 Then
Sheets("sheet1").Cells(i, 3) = "Sheet2 reports " & Sheets("sheet1").Cells(i, 2).Value - Sheets("sheet2").Cells(i, 2).Value & " more units of volume."
ElseIf Sheets("sheet1").Cells(i, 2) - Sheets("sheet2").Cells(i, 2) > 5 Then
Sheets("sheet1").Cells(i, 3) = "Sheet1 reports " & Sheets("sheet1").Cells(i, 2) - Sheets("sheet2").Cells(i, 2) & " more units of volume."
Else: Sheets("sheet1").Cells(i, 3) = "No or insignificant discrepancy"
End If
End If
Next
End Sub
I think you need to reuse rng like this:
rng.offset(2,0).value
in place of:
Sheets("sheet2").Cells(i, 2).Value
Because all your currently doing is assuming that the matching cell is in exactly the same row as in sheet1.
Your code should then look something like this:
Sub Again()
Dim lastRow As Integer
Dim rng As Range
lastRow = Sheets("Sheet1").Range("A65000").End(xlUp).Row
For i = 1 To lastRow
Set rng = Sheets("sheet2").Range("A:A").Find(Sheets("Sheet1").Cells(i, 1))
If rng Is Nothing Then
Sheets("Sheet1").Cells(i, 3) = "Item not in sheet2"
Sheets("Sheet1").Cells(i, 1).EntireRow.Interior.Color = vbRed
ElseIf Not rng Is Nothing Then
If Sheets("sheet1").Cells(i, 2).Value - rng.offset(0, 2).Value < -5 Then
Sheets("sheet1").Cells(i, 3) = "Sheet2 reports " & Sheets("sheet1").Cells(i, 2).Value - rng.offset(0, 2).Value & " more units of volume."
ElseIf Sheets("sheet1").Cells(i, 2) - rng.offset(0, 2).Value > 5 Then
Sheets("sheet1").Cells(i, 3) = "Sheet1 reports " & Sheets("sheet1").Cells(i, 2) - rng.offset(0, 2).Value & " more units of volume."
Else: Sheets("sheet1").Cells(i, 3) = "No or insignificant discrepancy"
End If
End If
Next
End Sub
Variables. ...If I understand your questions correctly.
dim myString as String
dim myFloat as Float
Related
I am new to VBA and I will need a help.
I have a worksheet named "Jobs" with raw data table and I want to copy paste certain cells to another worksheet named "Schedule" provided that the source and destination date matches and I use the below. But, I have 3 jobs for the same date and it copy only one. Any help will be appreciated.
Sub CopyBasedonSheet1()
Dim i As Long
Dim j As Long
Worksheets("Schedule").Range("B1:AJ92").ClearContents
Sheet1LastRow = Worksheets("Jobs").Range("G" & Rows.Count).End(xlUp).Row 'G is the Date Column'
Sheet2LastRow = Worksheets("Schedule").Range("A" & Rows.Count).End(xlUp).Row 'A is the Date column'
For j = 1 To Sheet1LastRow
For i = 1 To Sheet2LastRow
If Worksheets("Jobs").Cells(j, 7).Value = Worksheets("Schedule").Cells(i, 1).Value And Worksheets("Jobs").Cells(j, 1).Value = "P" Then
Worksheets("Schedule").Cells(i, 2).Value = Worksheets("Jobs").Cells(j, 3).Value
Worksheets("Schedule").Cells(i, 3).Value = Worksheets("Jobs").Cells(j, 9).Value
Worksheets("Schedule").Cells(i, 4).Value = Worksheets("Jobs").Cells(j, 14).Value
End If
Next i
Next j
End Sub
So I am trying to handle some data through VBA and I have a hard time figuring out how to do this the correct and less time consuming way when the data is getting handled.
I have an excel sheet that contains data from A:V with dynamic rows and including headers. But there is a lot of the data I do not need for any reasons.
So, my task is to take column K, P, Q, T, U, and V, and find all the unique combinations/values from this. Then I want to take this unique value and summarize what is in Column O. Afterwards I want to print this to a new sheet, where I have printed all the columns that made the combination. It could look like this:
HeadK
HeadP
HeadQ
HeadT
HeadU
HeadV
HeadO
Proj1
Actual
12
2022
Constrained
5
Proj2
Actual
12
2022
Constrained
1
Proj1
Actual
12
2022
Constrained
3
Proj2
Actual
5
2022
Constrained
10
The idea is just to tell that there can be a lot of combinations with so many columns. But in this case line 1 and 3 could be contained in 1 row, and instead present 8 in head0.
Can anybody help me with this?
I have actually tried some code from chatgpt, but can't get it to work correctly. I know it is not allowed to answer with it, but guess this is my own post, so I can admit my own mistakes....
Sub SummarizeData()
Dim ws As Worksheet
Dim dataRange As Range
Dim uniqueValues As Collection
Dim cell As Range
Dim uniqueValue As Variant
Dim summaryArray() As Variant
Dim summaryIndex As Long
' Define the worksheet
Set ws = ThisWorkbook.Sheets("TimeRegistrations_Billable")
' Define the data range
Set dataRange = ws.Range("K2:V" & ws.Range("K" & ws.Rows.Count).End(xlUp).Row)
' Create a collection to store unique values
Set uniqueValues = New Collection
' Iterate over the data range
For Each cell In dataRange.Columns(1).Cells
uniqueValue = cell.Value & cell.Offset(0, 6).Value & cell.Offset(0, 12).Value & cell.Offset(0, 13).Value & cell.Offset(0, 14).Value
On Error Resume Next
uniqueValues.Add uniqueValue, uniqueValue
On Error GoTo 0
uniqueValues.Add cell.Value, cell.Value & cell.Offset(0, 6).Value & cell.Offset(0, 12).Value & cell.Offset(0, 13).Value & cell.Offset(0, 14).Value & "K"
uniqueValues.Add cell.Offset(0, 10).Value, cell.Value & cell.Offset(0, 6).Value & cell.Offset(0, 12).Value & cell.Offset(0, 13).Value & cell.Offset(0, 14).Value & "T"
uniqueValues.Add cell.Offset(0, 11).Value, cell.Value & cell.Offset(0, 6).Value & cell.Offset(0, 12).Value & cell.Offset(0, 13).Value & cell.Offset(0, 14).Value & "U"
Next cell
' Create an array to store the summarized data
ReDim summaryArray(1 To uniqueValues.Count, 1 To 5)
summaryIndex = 0
' Iterate over the unique values
For Each uniqueValue In uniqueValues
summaryIndex = summaryIndex + 1
summaryArray(summaryIndex, 1) = uniqueValue
summaryArray(summaryIndex, 2) = WorksheetFunction.SumIf(dataRange.Columns(15), uniqueValue, dataRange.Columns(15))
summaryArray(summaryIndex, 3) = uniqueValue & "K"
summaryArray(summaryIndex, 4) = uniqueValue & "T"
summaryArray(summaryIndex, 5) = uniqueValue & "U"
Next uniqueValue
' Add the summarized data to a new worksheet
With ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
.Name = "Tester"
.Range("A1").Resize(uniqueValues.Count, 5).Value = summaryArray
End With
End Sub
So I actually have found 1 way to do it, I just need to remove all the duplicates in column 23 though. But this takes like ages to run, when you have 500k lines.
Don't know if this code makes more sense.
But when the duplicates in data1 column 23 has been removed, I have the data I want as the end gold (and more columns included which is not needed).
Sub uniquevalues()
Dim data1 As Variant, data2 As Variant
Dim lastRowTRB As Long, lastRowdata1 As Long
Dim timer As Double
Dim i As Long, k As Long
lastRowTRB = Worksheets("TimeRegistrations_Billable").Cells(Rows.count, "A").End(xlUp).row
data1 = Worksheets("TimeRegistrations_Billable").Range("A1:X" & lastRowTRB).Value
For i = 2 To lastRowTRB
If i > UBound(data1, 1) Then Exit For
data1(i, 23) = data1(i, 11) & data1(i, 16) & data1(i, 17) & data1(i, 20) & data1(i, 21) & data1(i, 22)
Next i
data2 = data1
For i = 2 To lastRowTRB
If i > UBound(data1, 1) Then Exit For
timer = 0
For k = 2 To lastRowTRB
If k > UBound(data2, 1) Then Exit For
If data2(i, 23) = data2(k, 11) & data2(k, 16) & data2(k, 17) & data2(k, 20) & data2(k, 21) & data2(k, 22) Then
timer = timer + data1(k, 15)
End If
Next k
data1(i, 24) = timer
Next i
With ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
.Name = "Tester"
.Range("A1").Resize(lastRowTRB, 24).Value = data1
End With
Following code is suggested by a helpful user, this works well to Calculate "From", "To", "MAX" etc values of a range. But this code gives results in every row of a range. I want to get the results in only first row of each row. Please help with this.
Sub trial()
Dim lastrow As Long
Dim destSht As Worksheet
Dim i As Long, j As Long
Set destSht = Worksheets("Final")
With Worksheets("Source")
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 2 To lastrow + 1 'loop whole range (column C)
If .Cells(i, "C") <> "" Then 'If column C is not empty then
For j = i To lastrow + 1 'Loop "group" range to find next empty cell. Start from current loop i to last row and add one row to get to next empty cell.
If .Cells(j, "C") = "" Then 'When next empty cell is found (i.e. end of small group range) then apply formulas
.Cells(i, "E").Value = .Cells(i, "B").Value 'From
.Cells(i, "F").Value = .Cells(j - 1, "B").Value 'To
.Cells(i, "G").Formula = "=MAX(C" & i & ":C" & j - 1 & ")" 'MAX
.Cells(i, "H").Formula = "=MIN(C" & i & ":C" & j - 1 & ")" 'MIN
.Cells(i, "I").Formula = "=AVERAGE(C" & i & ":C" & j - 1 & ")" 'AVG
Exit For
End If
Next j
End If
Next I
End With
End Sub
This Code gives following result
Desired Result
Try changing this line:
If .Cells(i, "C") <> "" Then 'If column C is not empty then
To this line:
If .Cells(i, "C") <> "" AND .Cells(i-1, "C") = "" Then 'If column C is not empty AND the column C above is empty then
I am trying to reformat a text file that has been imported into Excel.
I have done several minor reformatting points including adding rows, deleting page numbers, and combining headlines back into a single cell via the & function (the text file was delimited when importing).
After a concatenate, in which I took certain cells from columns A-Z and combined them in Column A, I tried to delete the now redundant information from Columns B-Z.
I tried selecting the cells and deleting, and also Range.Clear, but it does not delete the cells. I receive no errors.
This is what I have to take care of this step:
'Fix Duplicate Cells from Concatenate
For i = lastRow2 To 2 Step -1
If IsEmpty(Range(i, 1).Offset(-1, 0)) = True Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 26)).Clear
End If
Next
Ultimately, I would like to check if column A contains no information one row above the row where I would like to delete information from columns B-Z.
Full code:
Sub Format()
'This will delete page numbers
Dim lRow As Long
Dim iCntr As Long
lRow = 350
For iCntr = lRow To 1 Step -1
If IsNumeric(Cells(iCntr, 1)) Then
Rows(iCntr).Delete
End If
Next
'Add Row above each row with Headings
Dim lRow2 As Long, iRow As Long
With Worksheets("Sheet1")
lRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row in column A
'loop backwards (bottom to top = Step -1) through all rows
For iRow = lRow2 To 1 Step -1
'check if column A of current row (iRow) is "DIM"
If .Cells(iRow, "A").Value = "DIM" Then
.Rows(iRow).Resize(RowSize:=1).Insert xlShiftDown
'insert 1 row and move current (iRow) row down (xlShiftDown)
'means: insert 1 row ABOVE current row (iRow)
End If
Next iRow
End With
'Combine Headings back to single Cell
Dim lngLastRow As String
Dim lastRow As Long
Dim lastcolumn As Long
lastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
For i = lastRow To 1 Step -1
If Cells(i, 1).Value = "DIM" Then
Cells(i, 1).Value = Cells(i, 1).Value & " " & Cells(i, 2).Value & " " & _
Cells(i, 3).Value & " " & Cells(i, 4).Value & " " & Cells(i, 5).Value & " " & _
Cells(i, 6).Value & " " & Cells(i, 7).Value & " " & Cells(i, 8).Value & " " & _
Cells(i, 9).Value & " " & Cells(i, 10).Value & " " & Cells(i, 11).Value & " " & _
Cells(i, 12).Value & " " & Cells(i, 13).Value & " " & Cells(i, 14).Value & " " & _
Cells(i, 15).Value & " " & Cells(i, 16).Value & " " & Cells(i, 17).Value & " " & _
Cells(i, 18).Value & " " & Cells(i, 19).Value & " " & Cells(i, 20).Value & " " & _
Cells(i, 21).Value & " " & Cells(i, 22).Value & " " & Cells(i, 23).Value & " " & _
Cells(i, 24).Value & " " & Cells(i, 25).Value & " " & Cells(i, 25).Value
End If
Next
'Fix Duplicate Cells from Concatenate
For i = lastRow2 To 2 Step -1
If IsEmpty(Range(i, 1).Offset(-1, 0)) = True Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 26)).Clear
End If
Next
End Sub
The reason I have a condition set for the clearing of cells after concatenate is because I do not simply want to clear all cells in range B:Z, or even the specific rows in this range. I only want to clear this range in the instances where there is a blank line above it (headers to data). The reason being: I am trying to keep the spreadsheet as generic as possible in order to use it again if the specific layout of rows changes based on the input file.
First, the variable lastRow2 doesn't seem to be declared, and as you don't get any errors, you obviously don't use Option Explicit. Please do, because that will warn you about such errors.
Secondly, I don't see that you in any way initialize lastRow2, which explains why the loop is never run. Did you run the code in the debugger to verify values of variables and progress of the execution? That is the first thing to do when you see unexpected results.
Thirdly, I don't understand why you have the condition and why you use offset If IsEmpty(Range(i, 1).Offset(-1, 0)) = True. Just clear the cells explicitly
Try this instead:
lastColumn = 26
For i = lastRow To 1 Step -1
Range(Cells(i, 2), Cells(i, lastColumn)).Clear
Next
edit:
I noticed you have the last column as 25 (as well as the previous one) in the part where you concatenate the values from the cells. The correct last column is 26.
edit2:
Based on your edit of your question and assuming you have declared and initialized lastRow2 the corrected function would look like this:
For i = lastRow2 To 2 Step -1
If IsEmpty(Range(Cells(i, 1), Cells(i, 1)).Offset(-1, 0)) = True Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 4)).Clear
End If
Next
I have two columns, Column A has a set of a few standard values and column B has all unique values. I'm only just experimenting with more complex ways of compiling data than the beginner level so I'm a bit at a loss.
I need to either have a lookup or create a macro that will list only the values in A (once each) but also display which values in B correspond to those in A
for example
A | B
va1|abc
va1|bcd
Va2|xyz
va3|zab
will show (in a single cell) the following
va1: abc, bcd
va2: xyz
va3: zab
Please help!
Option Explicit
Sub Test()
Dim i As Long, j As Long, k As Long
k = 1
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountIf(Range("C:C"), Cells(i, 1).Value) = 0 Then
Cells(k, 3).Value = Cells(i, 1).Value
For j = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(j, 1).Value = Cells(k, 3).Value And _
InStr(Cells(k, 4).Value, Cells(j, 2).Value) = 0 Then
If Cells(k, 4).Value = "" Then
Cells(k, 4).Value = Cells(j, 2).Value
Else
Cells(k, 4).Value = Cells(k, 4).Value & ", " & Cells(j, 2).Value
End If
End If
Next j
k = k + 1
End If
Next i
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
Cells(i, 3).Value = Cells(i, 3).Value & ": " & Cells(i, 4).Value
Cells(i, 4).ClearContents
Next i
End Sub
Edited for single cell
In case your requirement is to "have the grouped data", and not exactly "have one single string per A", you can do this with a "pivot table" putting A and B in the row labels, like in the following picture: