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
Related
I have two tables in Excel, one with categories and listings, and another with points based on the category and listing threshold. It goes as follows:
Categories table:
ID
CATEGORY
LISTINGS
Points
001
A
56
002
C
120
003
A
4
004
B
98
Points table:
Category
tier1
tier2
tier3
A
Tier 1
Tier 2
Tier 3
Range
1-30
31-90
91-
Points
10
20
30
B
Tier 1
Tier 2
Tier 3
Range
1-25
26-100
101-
Points
10
20
30
C
Tier 1
Tier 2
Tier 3
Range
1-40
41-80
81-
Points
10
20
30
I started with an INDEX MATCH formula pointing at the points:
=INDEX(Points!A1:D11, MATCH(Categories!B2, Points!A1:A11, 0)+2)
--> the +2 is to get the points directly
I also though of evaluating the thresholds with this formula:
=IF(Categories!C2 >= NUMBERVALUE(LEFT(Points!D3, FIND("-",Points!D3)-1)),Points!D4, IF(Categories!C2 >=NUMBERVALUE(LEFT(Points!C3, FIND("-",Points!C3)-1)),Points!C4, Points!B4))
I thought that the else if the if would make it faster.
Could someone help me populate the Points column in the Categories table? VBA code is also acceptable. The tables are in different sheets.
José, your original Match formula is the right starting place. It locates the particular sub-table to do a further lookup on. But in order to make this formula a whole lot simpler, can we change the ranges (1-30, 31-90, 91-) to have just their starting points (1, 31, 91)? If we do that simple change then we can use the approximate lookup feature of HLookup to easily and compactly specify the Lookup:
=HLookup($C2,Offset(Points!$A$1,Match($B2,Points!$A:$A,0),1,2,3),2,True)
In the middle of this formula you can see your original Match function to locate the correct sub-table based on the category. We need to feed that start point to OFFSET() to create a table range useful to the HLookup. Offset takes an anchor cell reference (top left of the Points table), number of rows to count down from there (result of the Match), number of columns to the right (1), the number of rows in the range (2), and the number of columns in the range (3).
The Hlookup is just like a VLookup, but for tables arranged left-to-right not top-to-bottom. The True as the last parameter is very important as it tells HLookup to use the range lookup instead of an exact match.
A slightly verbose formula which takes the data as originally formatted (using Excel 365 Let):
=LET(ranges,INDEX(Points!B$2:D$12,MATCH(B2,Points!A$1:A$12,0),0),
leftRanges,VALUE(LEFT(ranges,FIND("-",ranges)-1)),
points,INDEX(Points!B$2:D$12,MATCH(B2,Points!A$1:A$12,0)+1,0),
INDEX(points,MATCH(C2,leftRanges)))
As it's urgent this is what I got but I cannot continue before tomorrow. Assuming you can at least put the tiers next to the category (A on same line as tiers) this will get you the first tier. You just need to copy the whole formula in the "nextCol", with minor modifications to get the next tiers.
if you really cannot change the source you need to add an additional offset in the first match.
=IF(AND(D1>NUMBERVALUE(LEFT(INDIRECT("B"&MATCH(E1,A:A,0)),FIND("-",INDIRECT("B"&MATCH(E1,A:A,0)))-1)),D1<NUMBERVALUE(RIGHT(INDIRECT("B"&MATCH(E1,A:A,0)),2))),INDEX(B:D,MATCH(E1,A:A,0)+1,1),"nextCol")
Option Explicit
Sub Score()
Dim wsP As Worksheet, wsC As Worksheet, dict
Dim iLastRow As Long, r As Long, i As Long, j As Integer
Dim sCat As String, iListing As Integer
Dim data, ar
Set wsP = Sheets("Points")
Set wsC = Sheets("Categories")
Set dict = CreateObject("Scripting.Dictionary")
iLastRow = wsC.Cells(Rows.Count, 1).End(xlUp).Row
data = wsC.Range("A1:D" & iLastRow).Value2
' category to row lookup
For i = 1 To UBound(data)
If data(i, 1) = "Range" Then
dict.Add Trim(data(i - 1, 1)), i ' range
End If
Next
' scan points
iLastRow = wsP.Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To iLastRow
sCat = Trim(wsP.Cells(r, "B"))
iListing = wsP.Cells(r, "C")
If dict.exists(sCat) Then
i = dict(sCat)
For j = 4 To 2 Step -1
ar = Split(data(i, j), "-") ' lower-upper limit
If iListing >= ar(0) Then ' check lower limit
' update points
wsP.Cells(r, "D") = data(i + 1, j) ' points
Exit For
End If
Next
Else
MsgBox "No match '" & sCat & "'", vbCritical, "ERROR row " & r
End If
Next
MsgBox "done"
End Sub
Please, try the next code. It uses arrays and should be very fast, working only in memory. Please use your sheets when setting shC and shP as your real sheets. I only use the active sheet and the next one for testing reason:
Sub GetPoints()
Dim shC As Worksheet, shP As Worksheet, lastRC As Long, lastRP As Long, arrBC, arrP, arrPP, arrFin
Dim i As Long, j As Long, p As Long, k As Long
Set shC = ActiveSheet 'use here your Categories sheet
Set shP = shC.Next 'use here your Points sheet
lastRC = shC.Range("A" & shC.rows.count).End(xlUp).row
lastRP = shP.Range("A" & shP.rows.count).End(xlUp).row
arrBC = shC.Range("B2:C" & lastRC).Value 'put the range B:C in an array
arrP = shP.Range("A2:D" & lastRP).Value 'put all the range in an array
ReDim arrFin(1 To UBound(arrBC), 1 To 1) 'redim the array to keep processed values
For i = 1 To UBound(arrBC) 'iterate between Categ array elements:
For j = 1 To UBound(arrP) 'iterate between Points array elements:
If arrP(j, 1) = arrBC(i, 1) Then 'if Category is found:
For p = 2 To 4 'iterate between the next array row elements
arrPP = Split(arrP(j + 1, p), "-") 'split the element by "-" to determine the interval
If arrPP(1) <> "" Then 'for the tier3 case:
If arrBC(i, 2) >= CLng(arrPP(0)) And arrBC(i, 2) <= CLng(arrPP(1)) Then
k = k + 1
arrFin(k, 1) = arrP(j + 2, p): j = j + 2: Exit For 'place the value in the final array and exit iteration
End If
Else 'for the tier1 and tier2 cases:
If arrBC(i, 2) >= CLng(arrPP(0)) Then
k = k + 1
arrFin(k, 1) = arrP(j + 2, p): j = j + 2: Exit For 'place the value in the final array and exit iteration
End If
End If
Next p
End If
Next j
Next i
'drop the final array result at once:
shC.Range("D2").Resize(UBound(arrFin), 1).Value = arrFin
End Sub
I have two documents having some same rows (and some rows are different). In Document1 I work with file and color some rows (or cells).
How could I switch to Documnent2 and color the rows (cells) I colored in Document1 in the same way? Is there any parser available?
For example:
Doc1:
1 a 1 2 3 4 # is full colored
2 b 1 3 6 7
3 c 1 1 1 2 # is full colored
Doc2:
1 c 1 1 1 2
2 a 1 2 3 4
3 d 5 6 8 1
4 b 1 3 6 7
I need to color rows with indexes 1 and 2, because they are the same as in Doc1, and are full colored.
If I use Format Painter, I get first and third rows colored, but it's wrong for me.
I see the solution like formula, that checks by row letter, is it colored, or not, and colors the row letter in other document. But I don't know how to code it :(
P.S. I also have troubles with getting cell colours - GET.CELL(63,INDIRECT("rc",FALSE)) doesn't work for me, there is no GET.CELL() function found.
P.P.S. Both documents are too big (more than 1.000.000 rows), so I think the best solution would be formula (macroses often are too slow).
The speed of the code depends on how many cells are coloured
You'd have to adapt it to fit your needs
Option Explicit
' Credits: https://stackoverflow.com/a/30067221/1521579
' Credits: https://www.mrexcel.com/board/threads/vba-to-compare-rows-in-two-different-sheets-and-if-they-match-highlight-in-red.1067232/
Sub CheckRows()
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Dim sourceSheet As Worksheet
Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
Dim targetFile As Workbook
Set targetFile = ThisWorkbook 'Workbooks("File2")
Dim targetSheet
Set targetSheet = targetFile.Worksheets("Sheet2")
Dim sourceLastRow As Long
sourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
Dim sourceRange As Range
Set sourceRange = sourceSheet.Range("A1:E" & sourceLastRow)
Dim targetLastRow As Long
targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
Dim targetRange As Range
Set targetRange = targetSheet.Range("A1:E" & targetLastRow)
Dim tempDict As Object
Set tempDict = CreateObject("scripting.dictionary")
Dim cellsString As String
' Add first range to dict
Dim sourceCell As Range
Dim sourceCounter As Long
For Each sourceCell In sourceRange.Columns(1).Cells
sourceCounter = sourceCounter + 1
' Check if cell has color
If sourceCell.Interior.Color <> 16777215 Then
cellsString = Join(Application.Index(sourceCell.Resize(, sourceRange.Columns.Count).Value, 1, 0), "|")
tempDict.item(cellsString) = sourceCell.Interior.Color
End If
Next sourceCell
' Check in target range
Dim targetCell As Range
Dim sourceColor As String
For Each targetCell In targetRange.Columns(1).Cells
cellsString = Join(Application.Index(targetCell.Resize(, targetRange.Columns.Count).Value, 1, 0), "|")
If tempDict.exists(cellsString) Then
sourceColor = tempDict.item(cellsString)
targetCell.Resize(, targetRange.Columns.Count).Interior.Color = sourceColor
End If
Next targetCell
SecondsElapsed = Round(Timer - StartTime, 2)
Debug.Print SecondsElapsed, "Source rows:" & sourceLastRow, "Target rows: " & targetLastRow
End Sub
' Credits: https://stackoverflow.com/a/9029155/1521579
Function GetKey(Dic As Object, strItem As String) As String
Dim key As Variant
For Each key In Dic.Keys
If Dic.item(key) = strItem Then
GetKey = CStr(key)
Exit Function
End If
Next
End Function
If you're comfortable with adding few helper columns in both of your documents, you can use the following solution.
Note that the below solution demonstrates the data being in 2 sheets
within the same document. You can easily apply the same logic with
different documents.
Assumptions:
Number of columns remain the same in both documents
you're looking for an exact match
Solution:
You can download the sample excel document with the below solution from the following link.
Create a helper column(G) in both the documents which is a concatenation of all the existing columns using =TEXTJOIN(", ",FALSE,B2:E2) like below:
A B C D E F -----G-------
1 a 1 2 3 4 a, 1, 2, 3, 4
2 b 1 3 6 7 b, 1, 3, 6, 7
3 c 1 1 1 2 c, 1, 1, 1, 2
In document2 create another column(H) which will identify the corresponding row number from document1 using =IFERROR(MATCH(G2,'document 1'!$G$1:$G$5,0),0) formula. Like below
Note: 0 if no match is found
Add a formula in any cell which will calculate the total number of rows that should be checked in document2
A B C D E F -------G----- H
1 c 1 1 1 2 c, 1, 1, 1, 2 3
2 a 1 2 3 4 a, 1, 2, 3, 4 1
3 d 5 6 8 1 d, 5, 6, 8, 1 0
4 b 1 3 6 7 b, 1, 3, 6, 7 2
5
6 =COUNTA(G1:G4)
Once these columns are added, you can use these columns to loop through the rows in document2 and see if there is match in document1 and copy formatting if there is a match using the code below:
Public Sub Copy_Formatting()
'Stack Overflow question: https://stackoverflow.com/questions/65194893/excel-transfer-color-filling-from-one-document-to-another
Dim Curr_Range As Range, Match_Value As Integer, Rows_to_loop As Integer
Rows_to_loop = Sheet2.Range("G6").Value
For i = 1 To Rows_to_loop
Set Curr_Range = Sheet2.Range("B1:E1").Offset(i, 0)
Match_Value = Sheet2.Range("H1").Offset(i).Value
If Match_Value > 0 Then
Sheet1.Range("B1:E1").Offset(Match_Value - 1).Copy
With Curr_Range.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Curr_Range.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
Next i
End Sub
Checkout the following GIF that shows the result:
two options:
Use the format painter (mark the cells for which you want to copy formatting, click the format painter icon, switch to Document 2, select the cells where you want to paste formatting)
Use "paste formatting" using Ctrl-C -> go to Document 2 -> Paste Special -> Formats.
If I understand your question correctly: you want to copy only the formatting from excel file 2 to excel file 1 while retaining the information.
copy everything from file 2.
paste it in file 1 and press ctrl. Pick the bottom-left option to only retain formatting.
If you're using conditional formatting you can also just make a backup of file 2 and paste file 1 into file 2 while only retaining text (one of the ctrl paste options).
Firstly the Data.
A B
Type 15 5
Type 2 7
Type 3 9
I need to create a loop, that starts at B1 and inserts a number of rows based on the cell value of B.
I found the below code , but it does not loop, and i need the next cell it checks to be the result of the first cell(5) + 1 in order for it to be correct.
**
Result should be :
**
A B
Type 1 5
Type 2 7
Type 3 9
etc.
Thanks in advance !
I messed up the question in the first place, however i have found the answer.
Please see below.
Sub InsertRowsIf()
Dim lr As Long, R As Range, i As Long
lr = Range("B" & Rows.Count).End(xlUp).Row
Set R = Range("B1", "B" & lr)
Application.ScreenUpdating = False
For i = R.Rows.Count To 1 Step -1
If IsNumeric(R.Cells(i, 1).Value) And Not IsEmpty(R.Cells(i, 1)) Then
R.Cells(i, 1).Offset(1, 0).Resize(R.Cells(i, 1).Value).EntireRow.Insert
End If
Next i
Application.ScreenUpdating = True
End Sub
I have a big Excel sheet with data taken from the sensors from one windfarm.
It is in one column, one below the other, just a clean numbers, integer (example 1435). Those columns represent data from every 15 minutes.
I need to get the data from it and transform it to 10 min data.
My idea was to divide it by 3 (get 5 min data) and just add two of those.
But I need the formula in excel which does that in the other column.
So takes the first column
divide it by 3,
put it in the column next to it,
copy it in 2 more rows below
then repeat the procedure but with the other value in the 15 min data, below the first one.
I hope it makes sense,
much appreciated for any assistance
Just create some simple loops.
Sub tenmindata()
Dim lastRow As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
lastRow = Range("A" & Rows.Count).End(xlUp).Row
j = 3
For i = 3 To lastRow
For k = 1 To 3
Cells(j, 7) = Cells(i, 3).Value / 3
j = j + 1
Next k
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Not sure if I got your question right but try this:
=A1/3*2
Post that in the column next to your data and doubleclick the small black dot:
https://abload.de/img/excelbwbzz.png
I need some help converting three colums into a matrix using excel macro.
Here is an example:
From this:
A A 0
A B 23
A C 3
B A 7
B B 56
B C 33
C A 31
C B 6
C C 5
to this:
A B C
A 0 23 3
B 7 56 33
C 31 6 5
Hope you can help me.
Thanks
Not quite sure what exactly you are meaning by matrix. For the code below I assumed you were looking for a way to read the data in the first two columns as Row and Column data of the output table. Assume the input data is in the Columns 1 - 3 of "Sheet1"
Sub ConvertTableOfData()
Dim testArray(1 to 3)
Dim chkROW as Integer
Dim chkCOL as Integer
Dim chkVAL as Integer
'// index the Row and Column headers
testArray(1) = "A"
testArray(2) = "B"
testArray(3) = "C"
'// Iterate through every row in the initial dataset
For i = 1 to Worksheets("Sheet1").Cells(1, 1).End(xlDown).Row
With Worksheets("Sheet1")
'// Assign the Output Row and Column values
'// based on the array indices
For j = 1 to UBound(testArray, 1)
If .Cells(i, 1) = testArray(j) Then
chkROW = j
End If
If .Cells(i, 2) = testArray(j) Then
chkCOL = j
End If
Next j
'// store the actual value
chkVAL = .Cells(i, 3)
End With
'// output table (in Sheet2)
With Worksheets("Sheet2")
.Cells(chkROW, chkCOL) = chkVAL
End With
Next i
'// Add headers to Output table
For i = 1 to 3
With Worksheets("Sheet2")
.Cells(i + 1, 1) = testArray(i)
.Cells(i, i + 1) = testArray(i)
End With
Next i
End Sub
You can also perform this without VBA.
Assume your table of data is in the range A1:C9.
Assume the first number (0) in the 3 by 3 grid of data is cell F3, with A, B, C in the row above, and A, B, C in the column to the left.
Enter the formula in cell F3 as
=INDEX($C$1:$C$9,SUMPRODUCT(--($A$1:$A$9=$E3),--($B$1:$B$9=F$2),ROW($A$1:$A$9)))
Copy this formula to all 9 cells in the 3 by 3 grid.
This generalized to any size of data.