I need help to write macro to compare two sheets in excel, sheet1 and sheet2 on same excel book and display all the differences between both the sheets on sheet3.
My headings will always be the same between sheet1 and sheet2 but the information in both the sheets may vary.
I included the headings that will be on both the sheets:
ID Number Date of Birth Payroll Number Surname First Name Salary Member Group
I am struggling with this. So please extend your helping hands
Thank you.
Assuming 'i' is the number of rows in Sheet1 and 'm' is the number of rows in Sheet2 and 7 headings in each sheets, then this is the solution where the mismatches are registered in Sheet3
Here the Id numbers in Sheet1 is compared with Id numbers in Sheet2 and if present, then they are compared and the mismatches are reported in sheet3 in the same order of the Headings
Sub Mismatch()
Dim temp3 As Integer
temp3 = 1
Dim array1(7), array2(7), array3(7) As Variant
For i = 2 To 6
Worksheets("Sheet1").Activate
For temp = 1 To 7
array1(temp) = Cells(i, temp).Value
Next temp
Worksheets("Sheet2").Activate
For m = 2 To 6
If Cells(m, 1).Value = array1(1) Then
For n = 1 To 7
For temp2 = 1 To 7
array2(temp2) = Cells(m, temp2).Value
Next temp2
Worksheets("Sheet3").Activate
temp3 = temp3 + 1
Cells(temp3, 1).Value = array1(1)
For temp4 = 2 To 7
If array1(temp4) <> array2(temp4) Then
Cells(temp3, temp4).Value = "mismatch"
End If
Next temp4
GoTo JumpToHere
Next n
End If
Next m
JumpToHere:
Next i
End Sub
I Hope this helps
Related
I have two excel sheets, one cumulative (year-to-date) and one periodic (quarterly). I am trying to check for potential entry errors.
Simplified ytd table:
ID Q1/18 Q2/18 Q3/18 Q4/18 Q1/19 Q2/19 ...
1 6 12 20 28 10 20
2 5 11 18 26 10 20
3 5 11 18 26 10 20
Simplified quarterly table:
ID Q1/18 Q2/18 Q3/18 Q4/18 Q1/19 Q2/19 ...
1 6 6 8 8 10 10
2 5 6 7 8 10 10
3 5 6 7 8 10 10
In the above example there are no entry errors.
I am trying to create a third sheet that would look something like this
ID Q1/18 Q2/18 Q3/18 Q4/18 Q1/19 Q2/19 ...
1 T T T T T
2 T T T T T
3 T T T T T
I initially tried using a formula like this:
=IF('YTD'!C2-'YTD LC'!B2-'QTR'!B2=0,T,F)
I don't particularly like this because the formula will not apply in the first quarter. This also assumes that my data in both sheets are ordered in the same way. Whilst I believe it to be true in all cases, I would rather have something like an index-match to confirm.
I tried working on a VBA solution based on other solutions I found here but made less progress than via the formulas:
Sub Compare()
lrow = Cells (Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xltoLeft).Column
Sheets.Add
ActiveSheet.Name = "Temp Sheet"
For i = 2 To lrow
For j = 3 To lcol
valytd = Worksheets("YTD").Cells(i,j).Value
valytd = Worksheets("YTD").Cells(i,j).Value
If valytd = valytd Then
Worksheets("Temp").Cells(i,j).Value = "T"
Else:
Worksheets("Temp").Cells(i,j).Value = "F"
Worksheets("Temp").Cells(i,j).Interior.Color Index = 40
End If
Next j
Next i
End Sub
In my opinion the easiest way is to:
Create a sheet & copy paste row 1 + Column 1 like image below (Title & IDs)
Use Sum Product to get your answers
Formula:
=IF(SUMPRODUCT((Sheet1!$B$1:$G$1=Sheet3!$B$1)*(Sheet1!$A$2:$A$4=Sheet3!A2)*(Sheet1!$B$2:$G$4))=SUMPRODUCT((Sheet2!$B$1:$G$1=Sheet3!$B$1)*(Sheet2!$A$2:$A$4=Sheet3!A2)*(Sheet2!$B$2:$G$4)),"T","F")
Formula Notes:
Keep fix the range with Quarters using double $$ -> Sheet1!$B$1:$G$1
keep fix the range with IDs using double $$ -> Sheet1!$A$2:$A$4
Keep fix the range with values -> Sheet1!$B$2:$G$
Keep fix column header -> =Sheet3!$B$1
Leave variable rows number -> =Sheet3!A2
Images:
This should do the trick, the code is all commented:
Option Explicit
Sub Compare()
Dim arrYTD As Variant, arrQuarterly As Variant, arrResult As Variant
Dim Compare As Scripting.Dictionary 'You need Microsoft Scripting Runtime for this to work
Dim i As Long, j As Integer, x As Integer
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
.ScreenUpdating = False
End With
With ThisWorkbook
arrYTD = .Sheets("Name of YTD sheet").UsedRange.Value 'this will get everything on that sheet
arrQuarterly = .Sheets("Name of Quarterly sheet").UsedRange.Value 'this will get everything on that sheet
End With
ReDim arrResult(1 To UBound(arrYTD), 1 To UBound(arrYTD, 2)) 'resize the final array with the same size of YTD
Set Compare = New Scripting.Dictionary
'Here we fill the dictionary with the ID's position on the arrQuarterly array
For i = 2 To UBound(arrQuarterly) '2 because 1 is headers
If Not Compare.Exists(arrQuarterly(i, 1)) Then 'this is an error handle if you have duplicated ID's
Compare.Add arrQuarterly(i, 1), i 'now we know the position of that ID on the table
Else
'Your handle if there was a duplicated ID
End If
Next i
'Let's fill the headers on the result array
For i = 1 To UBound(arrYTD, 2)
arrResult(1, i) = arrYTD(1, i)
Next i
'Now let's compare both tables assuming the columns are the same on both tables (same position)
For i = 1 To UBound(arrYTD)
arrResult(i, 1) = arrYTD(i, 1) 'This is the ID
For j = 2 To UBound(arrYTD, 2)
x = Compare(arrYTD(i, 1)) 'this way we get the position on the quarterly array for that ID
If arrYTD(i, j) = arrQuarterly(x, j) Then 'compare if they have the same value on both sides
arrResult(i, j) = "T"
Else
arrResult(i, j) = "F"
End If
Next j
Next i
With ThisWorkbook.Sheets("Name of the result sheet") 'paste the array to it's sheet
.Range("A1", .Cells(UBound(arrResult), UBound(arrResult, 2))).Value = arrResult
End With
End Sub
I am trying to add values from different sheets (Sheet 2 to 5) into my main sheet (Sheet 1). In Sheet 1 I want the cells to contain the right formula pointing to the different sheets (if possible).
Typically like this:
='Sheet2'!D5+'Sheet3'!D165
All my sheets have different products, but some sheets contain same products. So I want to search through them all and ADD them in my Main Sheet (Sheet 1).
Sub UpdateMainSheet()
' Kode for å Oppdatere Plukkeliste Alle Artikler Summert
Dim AktivtArk As String
Dim AktivtArkNavn As String
Dim K As Integer
Dim Count As Integer
'Line of code to delete old data in Main Sheet:
Worksheets("Sheet1").Range("A2:H10000").Clear
AktivtArkOverskrift = "List of Articles from Sheet 2 to 5"
'Creates Headline in Main Sheet:
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("Sheet1").Cells(eRow, 1) = AktivtArkOverskrift
Worksheets("Sheet1").Cells(eRow, 1).Font.Bold = True
'Script to check and gather data from the other sheets (Sheet 2, 3, 4 and 5):
For K = 2 To 5
'For loop to check each line in sheet "K"
For I = 2 To 1000
'If function to check if the cell I in column F is empty, if so it_jumps to next row and do the same check:
If Worksheets(K).Cells(I, 6) > 0 Then
Count = 0
'For loop to check if I already have a row in the Main Sheet with the article I'm checking:
For L = 2 To 1000
'If function to check if the articles have the same article number:
If Worksheets(K).Cells(I, 1) = Worksheets("Sheet1").Cells(L, 1) Then
'Line of code that are supposed to ADD the values that is currently in the Main Sheet, togheter with the value in Sheet K:
Worksheets("Sheet1").Cells(I, 4).Formula = Worksheets("Sheet1").Cells(I, 4) + Worksheets(K).Cells(L, 4)
End If
Next L
End If
Next I
Next K
End Sub
So what I need to fix in my code is this part (located furthest inside the For Loop):
Worksheets("Sheet1").Cells(I, 4).Formula = Worksheets("Sheet1").Cells(I, 4) + Worksheets(K).Cells(L, 4)
And make it create a formula in the wanted cell, that looks something like this:
='Sheet2'!D5+'Sheet3'!D165
It must be able to add another cell as well, since the Loop are running through several Sheets (Sheet 2 to 5) that may contain the same products.
I.e. I only want one line in my Main Sheet for each product.
I managed to find the solution in the end.
It seemed I had switched the L and I in som of the looping, which resulted in the values not to be added togheter.
The following code (I did not translate to English, but can do this if someone wants/need it) solved my issue, and gave me the values from Sheet 2 to 5 sorted by product in Sheet 1:
Sub OppdaterePlukkelisteSummert()
'Kode for å Oppdatere Plukkeliste Alle Artikler Summert
Dim AktivtArk As String
Dim AktivtArkNavn As String
Dim K As Integer
Dim Teller As Integer
Dim value1 As Integer
Dim value2 As Integer
'Sletter Plukklisten for å oppdatere og sortere på nytt:
Worksheets(1).Range("A2:H10000").Clear
'HENTING AV DATA FRA ARKET "K":
AktivtArk = "Artikler Summert fra Alle Ark"
AktivtArkOverskrift = "Artikler Summert fra Alle Ark"
'Setter inn Overskrift som Forteller kva ark utstyret kommer fra:
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets(1).Cells(eRow, 1) = AktivtArkOverskrift
Worksheets(1).Cells(eRow, 1).Font.Bold = True
'Sjekker hvilke/hvilket rader/utstyr som skal plukkes, og legger det inn i "Ark1":
For K = 2 To 5
For I = 2 To 1000
If Worksheets(K).Cells(I, 6) > 0 Then
Teller = 0
For L = 2 To 1000
If Worksheets(K).Cells(I, 1) = Worksheets(1).Cells(L, 1) Then
value1 = Worksheets(1).Cells(L, 4)
value2 = Worksheets(K).Cells(I, 4)
Worksheets(1).Cells(L, 4) = value1 + value2
Worksheets(1).Cells(L, 6) = value1 + value2
Else
Teller = Teller + 1
End If
Next L
If Teller > 998 Then
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For J = 1 To 11
Worksheets(1).Cells(eRow, J) = Worksheets(K).Cells(I, J)
Next J
Worksheets(1).Cells(eRow, 6).Font.Color = RGB(0, 150, 0)
Worksheets(1).Cells(eRow, 7).Font.Color = RGB(0, 150, 0)
End If
End If
Next I
Next K
Worksheets(1).Range("A2").Select
End Sub
I hope this can be useful for someone else :-)
All help and suggestion in the comments are appreciated!
I was going to illustrate with this simple example:
I = 1 'for example
For K = 2 To 5
Worksheets("Sheet1").Cells(I, 4).Value = Worksheets("Sheet1").Cells(I, 4).Value + _
WorksheetFunction.SumIf(Worksheets(K).Range("A:A"), "Bananas", Worksheets(K).Range("D:D"))
Next K
English isn't my first language so I hope you will understand me
Beacuse I dont know anything about programming I am turning for help to you: Excel pros;)
I have a workbook with two sheets ( datafeed and record )
On "datafeed", column B, cells B2 to B400 I am capturing live prices from internet.
Currently I use the following :
Sub my_onTime()
Application.OnTime Now + TimeValue("00:00:01"), "my_Procedure"
End Sub
Sub my_Procedure()
With Sheets("record")
rw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range(.Cells(rw, 1), .Cells(rw, 2)).Value = Sheets("datafeed").Range("a2:b2").Value
End With
ThisWorkbook.RefreshAll
my_onTime
End Sub
which currently records prices from "datafeed" to rows in "record".
Another problem is that records only one cell from "datafeed"; cell B2 . I dont know how to set it, so it would record all prices in range from cells B2:B400
My wish is that Excel would record price changes to"record" Sheet into columns not rows.
"Graphic" display what I want:
Sheet1 - "datafeed" ... B2 = 155............Sheet 2 - "record" cells : F2 = 155.....G2 = 150.....H2 - 145.....I2 - 140,....and so on
Sheet1 - "datafeed" ... B3 = 66.............Sheet 2 - "record" cells : F3 = 66.....G3 = 67....H3 - 66.....I3 - 65,....and so on
Sheet1 - "datafeed" ... B4 = 1015.............Sheet 2 - "record" cells : F4 = 1015.....G4 = 1025....H4 - 1035....I4 - 1045,....and so on
Also last recorded price must be put in first column Sheet 2 - "record"; cells: , F2,F3,F4.......(Right now last recorded value is put in last row )
Any help will be greatly appreciated.
Thank you!
p.s
I have added 3 pics for clarification
1. sheet datafeed
2. sheet record
3. what i wish for sheet record
replace this part of your procedure
With Sheets("record")
rw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range(.Cells(rw, 1), .Cells(rw, 2)).Value = Sheets("datafeed").Range("a2:b2").Value
End With
with this
With Sheets("record")
rw = .Cells(.Rows.Count, 5).End(xlUp).Row + 1
.Cells(rw, 5).Value = Sheets("datafeed").Cells(2, 1).Value 'write name from column A
iColumn = 6 'set you want to start in column F with prices
For iRow = Sheets("datafeed").Cells(Sheets("datafeed").Rows.Count, 1).End(xlUp).Row To 2 Step -1
.Cells(rw, iColumn).Value = Sheets("datafeed").Cells(iRow, 2).Value
iColumn = iColumn + 1
Next iRow
End With
if you want the new line added to first line instead of the last
With Sheets("record")
iColumn = 6 'set you want to start in column F with prices
iRecordRow = 3 'set to what row number to put the current price
.Rows(iRecordRow & ":" & iRecordRow).Insert Shift:=xlDown
For iRow = Sheets("datafeed").Cells(Sheets("datafeed").Rows.Count, 1).End(xlUp).Row To 2 Step -1
.Cells(iRecordRow, iColumn).Value = Sheets("datafeed").Cells(iRow, 2).Value
iColumn = iColumn + 1
Next iRow
.Cells(iRecordRow, 5).Value = Sheets("datafeed").Cells(2, 1).Value 'write name from column A
End With
if you want it added to different row than 3 just change number in iRecordRow = 3
So I have column A (contains the word) and column C (contains the date) shown below. The columns are occasionally separated by new headers, such as for "Word" and "Date" and a blank space.
Word Date
BV 12/06/2017
BV 12/06/2017
BV 13/06/2017
BV 13/06/2017
BR 17/07/2017
BR 17/07/2017
BR 24/07/2017
Word Date
BT 30/07/2017
BT 30/07/2017
Word Date
BY 05/08/2017
First the date would be converted in terms of week number into a new column D, such as 12/06/2017 to week 24.
Using something like:
Sub TimeConverter()
Dim I as Long, MaxRow as Long
MaxRow = Range("A" & Rows.count).End(xlUp).Row
For I = 2 to MaxRow
Cells(I, "D").Value = DatePart("ww", Cells(I, "C"), 7)
Next
End Sub
Then I would like the VBA macro code to look through column A and find the number of times a word appears and match with a date on the same week number into a new column B.
Using something like:
=COUNTIF(A:A, "BV")
=COUNTIF(A:A, "BR")
Output
# 4
# 3
Now to then combine them together so that the unique word (column A) counts (column B) can be separated into the corresponding week number (column D).
Desired Output:
BV 4 24
BR 2 29
BR 1 30
BT 2 30
BY 1 31
Any suggestion would be great!
Thank you.
Let's say that with your VBA code you have managed to get something like this as an input:
Then, as mentioned in the comments, you need to implement a dictionary to get something like this:
As you see, the keys of the dictionary is the word + the week number together. Thus BR29 is different than BR30.
Copy the sample input, run the code below and you will get the desired output:
Option Explicit
Public Sub TestMe()
Dim myDict As Object
Dim lngCounter As Long
Dim strKey As String
Dim objKey As Object
Set myDict = CreateObject("Scripting.Dictionary")
For lngCounter = 1 To 14
strKey = Cells(lngCounter, 1) & Cells(lngCounter, 3)
If myDict.exists(strKey) Then
myDict(strKey) = myDict(strKey) + 1
Else
myDict(strKey) = 1
End If
Next lngCounter
For lngCounter = 0 To myDict.Count - 1
Cells(lngCounter + 1, 6) = myDict.Items()(lngCounter)
Cells(lngCounter + 1, 7) = myDict.keys()(lngCounter)
Next lngCounter
End Sub
Then you have to work more to find a way to split the keys from BV24 to BV and 24. You need to find a way to eliminate the zero from the results as well.
I have 2 columns, one with dates (column A:A, of type dd/mm/yyyy hh:mm) the other with values of a parameter (column B:B), registered at each date. But not all dates have registered values (in which case in column B I will have -9999.
What I need is to copy to other columns (say D:D and E:E) only the cells where there is a value other than -9999 and the correspondent date too. For example:
Example
My data series is pretty long, it can get to 10000 or more lines, so I cannot do this selection “manually”. I would prefer macros, not array formulae, because I want to choose the moment of the calculation.
This code should do what you are looking for. This will copy all rows with a value in column B, into columns D and E.'
Sub copyrows()
Dim RowNo, newRowNo As Long
RowNo = 2
newRowNo = 2
With ThisWorkbook.ActiveSheet
.Cells(1, 4).Value = "Date"
.Cells(1, 5).Value = "H_Selected"
Do Until .Cells(RowNo, 1) = ""
If .Cells(RowNo, 2) <> "-9999" Then
.Cells(newRowNo, 4) = .Cells(RowNo, 1)
.Cells(newRowNo, 5) = .Cells(RowNo, 2)
newRowNo = newRowNo + 1
End If
RowNo = RowNo + 1
Loop
End With
End Sub