I have an issue when trying to use Union(Range, Range). I am trying to copy certain rows from one worksheet and paste them in a new file. My issue is that the Union isn't adding on more rows to the range; it returns the original range. If I flip the order of the parameters, it returns only the .Rows(i + 1) row. My test data has 2 rows that it should copy. The row count at the end is 1. What am I doing wrong?!
Dim lastRow, i As Long
Dim CopyRange As Range
lastRow = ActiveSheet.Rows.count
With Sheets(ActiveSheet.Name)
lastRow = .Range("A" & .Rows.count).End(xlUp).Row
For i = 2 To lastRow
Dim endTime As Date
endTime = DateValue(Trim(.Range("E" & i).Value))
If endTime = Date - 1 Then
If CopyRange Is Nothing Then
Set CopyRange = .Rows(i + 1)
Else
Set CopyRange = Union(CopyRange, .Rows(i + 1))
End If
End If
Next
End With
CopyRange.Copy
Actually CopyRange contains a number of separate ranges (areas). See here for more information.
When you make Union operation with separate rows (I mean that there is another row beetween them) it doesen't actually add Row, but add new Area. So, if you add MsgBox CopyRange.Areas.Count, you will see count of areas (if you will add MsgBox CopyRange.Rows.Count it will get you uncorrect result in case of many areas - it will get count of rows in first area).
As a conclusion, your code works well for me, and should works well for you. You can add CopyRange.Select line before CopyRange.Copy and set breakpoint on this line. You will see that union works well
Related
I have exported CSV files from a Development SQL Server and another from Production.
The table (in the database) has two columns
UserID
DocumentID
both of these should be unique values.
I want to be able to verify that those two combinations (together) match the other environment.
So far I imported both CSV files in separate worksheets in Excel.
After this, I am not sure what I should do to compare these columns?
I did a little google-ing and there are so many different types of answers but not sure how to do it.
Conditional Formatting only works if I select a single column. I need to get the combination of both columns.
A quick and mildly dirty VBA-approach. I assumed your workbook consists of two worksheets, each containing two columns with headers.
Option Explicit
Sub SoftwareIsFun()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim dicObj As Object
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim i As Long
Set dicObj = CreateObject("Scripting.Dictionary")
Set wks1 = ThisWorkbook.Worksheets(1)
Set wks2 = ThisWorkbook.Worksheets(2)
With wks1
lastRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow1
If Not dicObj.Exists(.Range("A" & i).Value) Then
dicObj.Add .Range("A" & i).Value, .Range("B" & i).Value
Else
.Range("C" & i).Value = "UserID already exists"
End If
Next i
End With
With wks2
lastRow2 = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow2
If dicObj.Exists(.Range("A" & i).Value) Then
If .Range("B" & i).Value = dicObj.Item(.Range("A" & i).Value) Then
.Rows(i).Interior.Color = vbGreen
Else
.Rows(i).Interior.Color = vbRed
End If
Else
.Rows(i).Interior.Color = vbRed
End If
Next i
End With
End Sub
What you are describing is something I do daily for my job:
Step 1
Create a 3rd column in both worksheets called "Key" where you'll concatenate the values for Column's A & B as follows:=A2&B2.
Now autofill your rows in column C with the previous formula you've written.
Step 2
Remove duplicates found in this column you've created, this will effectively preserve pairs and prevent information loss when removing duplicate values. (Data Tab -> Remove Duplicates -> Select column C as the criteria to remove them).
Step 3
Make a Vlookup in a 4th column in your first worksheet, the function takes 4 parameters: =vlookup(C2, <4th column of the other worksheet (select entire range from row 2 to end)>, 1, 0) and autofill your rows with the formula.
If you aren't yet familiar with vlookup yet I strongly advice you watch a brief tutorial on its usage, it is an essential tool to compare data.
Any value that matches will be displayed, whereas an #N/D error will print for those which don't match between the 2 tables.
So my issue is that I have an input sheet that I can't change the formatting of. Unfortunately they used a line of equal signs =========== in a cell for differentiating the sections. I now need to copy/paste certain columns (almost as a whole) including theses "separator cells", however those can't be copied because they aren't recognised as strings. The error msg is Run-time error 1004: Application-defined or object-defined error, which is guess stems from the fact that I want to copy paste a cell with an equal sign in the front, so normally a formula. The columns also include different data types, so I can't really force everything to be a string. How can I skip these or even better copy/paste them into my other worksheet?
My problem is a very isolated issue so I'll just give the relevant lines of code. For context: wksh and wksh2 are declared worksheets, LastRow is the declared last row of the column, etc. It works for other columns, just not the one's with these ======== cells.
Dim arrC As Variant
arrC = wksh.Range("A2:" & LastRow)
wksh2.Range("A2").Resize(UBound(arrC), 1).Value = arrC
First note that "A2:" & LastRow is no valid address as the column letter for the second part is missing. It needs to be something like "A2:A" & LastRow
First Option
One option is to loop through the array and test each element if it begins with = and replace it with '= (the apostroph is not shown but ensures that it is handled as text and not as formula). Note that this will kill all formulas in that range.
Dim arrC As Variant
arrC = wksh.Range("A2:A" & LastRow).Value
Dim iRow As Long
For iRow = 1 To UBound(arrC, 1)
Dim iCol As Long
For iCol = 1 To UBound(arrC, 2)
If Left$(arrC(iRow, iCol), 1) = "=" Then
arrC(iRow, iCol) = "'" & arrC(iRow, iCol)
End If
Next iCol
Next iRow
wksh2.Range("A2").Resize(UBound(arrC), 1).Value = arrC
Second Option
The second option is to set the number format of the destination to text: .NumberFormat = "#" then paste the values and turn it back to general.
Dim arrC As Variant
arrC = wksh.Range("A2:A" & LastRow).Value
With wksh2.Range("A2").Resize(UBound(arrC), 1)
.NumberFormat = "#"
.Value = arrC
.NumberFormat = "General"
End With
Note that .NumberFormat = "#" will turn also numbers into text so you need to turn it back to General to ensure that if there were numbers they are turned back to numbers again and you can calculate with them.
This workaround might have some odd effects on dates or other number formats. So this might not be a reliable solution depending on what data you have.
Third Option
Last option is .Copy and .PasteSpecial
wksh.Range("A2:A" & LastRow).Copy
wksh2.Range("A2").PasteSpecial xlPasteValuesAndNumberFormats
'or without number formats
wksh2.Range("A2").PasteSpecial xlPasteValues
Are you performing any special operation post loading the data into an array? If not then I'd suggest using simple copy and paste routine through VBA which should work reliably.
Public Sub CopyPasteData()
Dim wksh As Worksheet, wksh2 As Worksheet
Set wksh = ThisWorkbook.Sheets(1)
Set wksh2 = ThisWorkbook.Sheets(2)
wksh.Range("A2:" & LastRow).Copy wksh2.Range("A2")
End Sub
I am quite new to VBA so my question may sound silly to some of you.
I have a problem with my code. I am trying to check between 2 sheets(1st: test and 2nd: test data. In the code I am using the code name of the sheets) how may times a criteria/my product is met and based on that number to add that many rows beneath the SKU/product.
What I want to do is, if for my first product/SKU I have stock in 5 different locations, I want to add 5 rows in the first sheet and to see the qty in column D and the location in column E.
TestData tab
The reason why I need to list the quantity in different cells is that the stock is in different locations, so I can not just add in to one cell.
I am also adding screen shots of how my two sheets look like.
I have not add the loop to find the location yet, but I want to understand how to add the rows first.
Sub test()
Dim myrange As Range, testrange As Range, cell As Range, result As Range
Dim i As Long, testlastrow As Long, lastrow As Long
Dim helprng As Range
lastrow = TESTTAB.Range("a" & Rows.Count).End(xlUp).row
testlastrow = TDATA.Range("a" & Rows.Count).End(xlUp).row
Set testrange = TDATA.Range("a2:c" & testlastrow)
Set myrange = TESTTAB.Range("b2:b" & lastrow)
Set result = TESTTAB.Range("d2:e" & testlastrow)
Set helprng = TESTTAB.Range("f2:f" & lastrow)
For Each cell In myrange
For i = 1 To lastrow
If cell.Cells(i, 1) = testrange.Cells(i, 1) Then
result.Cells(i, 1) = testrange.Cells(i, 2)
End If
Next i
Next cell
End Sub
Here is the raw structure you were asking for.
Sub test()
' 011
Dim Rng As Range
Dim Tmp As Variant
Dim Radd As Long ' number of rows to add
Dim R As Long ' row counter
With Tdata
' Range, Cells and Rows Count, all in the same sheet
' exclude caption row(s)
Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
Application.ScreenUpdating = False ' speed up the process
With TestTab
' end the loop in row 2 because row 1 might contain captions
' loop bottom to top because row numbers will change
' below the current row as you insert rwos
' column 1 = "A"
For R = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
Tmp = .Cells(R, 1).Value
Radd = Application.CountIf(Rng, Tmp)
If Radd > 1 Then
.Range(.Rows(R + 1), .Rows(R + Radd)).Insert
.Cells(R + 1, 1).Value = Radd ' for testing purposes
End If
Next R
End With
Application.ScreenUpdating = True ' now you look
End Sub
As our Evil Blue Monkey has suggested, inserting blank rows and then populating them may not be the most efficient way. You can copy a row and then click Insert to insert the copied data into a new row. Get the syntax from the Macro recorder if it's of interest. It works with the Range object the same way.
I am trying to replicate this view where new rows in the bottom table are created based on the values in Column'A' of the top table.
Here is my code:
Sub testProc()
Worksheets("Sheet1").Activate
Dim r, count As Range
Dim LastRow As Long
Dim temp As Integer
'Dim lngLastRow As Long
Set r = Range("A:L")
Set count = Range("A:A")
LastRow = Range("F" & 9).End(xlUp).Row
'LastRow = Cells(Rows.count, MyRange.Column).End(xlUp).Row
For n = LastRow To 1 Step -1
temp = Range("A" & n)
If (temp > 0) Then
Rows(n + 1 & ":" & n + temp).Insert Shift:=xlDown
Range("H" & (ActiveCell.Row) - 2).Copy Range("E" & (ActiveCell.Row) - 1)
Range("G" & (ActiveCell.Row)).Select
'ActiveCell.Offset(RowOffset:=1, ColumnOffset:=-6).Activate
'Cells(ActiveRow, 8).Value.Cut
'Cells.Offset(2 - 6).Value.Paste
'Range("G" & (ActiveCell.Row)).Select
'ActiveCell.Offset(0 - Selection.Column + 1).Range("A1:AG1").Select
'Value = Range(G, H)
'ActiveCell.Offset(1, -6).Paste
'ActiveCell.Offset(1, -6).Paste
'ActiveCell.Offset(RowOffset:=1, ColumnOffset:=-6).Paste
'Range.Offset(1, -6).Paste
'Value = Range("G" & (ActiveCell.Row), "H" & (ActiveCell.Row)).Value
'ActiveCell.Offset(2, -6).Range
'ActiveCell.Offset(rowOffset:=3, columnOffset:=3).Activate
End If
Next n
End Sub
I do not know what I am doing and Excel is crashing with and without messages
The easiest solution to this would be to use two separate worksheets, but you can work around this pretty easily with some math or a cell with a reserved word. You also want to use as few reference variables as possible and let Excel tell you what the ranges are defined as by using contiguous ranges.
I'm not going to write the whole function for you, but give you the building blocks that will let you piece it together and hopefully you'll learn more as you do it.
Here's how to set up the object variables that you'll reference throughout the code:
Dim sourceSheet as Worksheet
Dim targetSheet as Worksheet
' replace with the names of sheets you want to use
sourceSheet = Worksheets("Sheet1")
targetSheet = Worksheets("Sheet2")
Now, for looping through the source table. If you know that the first row in the Sheet is always the Title row and your instructions start in row 2 then you can use this to loop through every instruction:
Dim sourceRowIndex = 2
While Not IsEmpty(sourceSheet.cells(sourceRowIndex, 1))
' ** do stuff here
' increment row index
sourceRowIndex = sourceRowIndex + 1
Wend
You could also use a For Each loop or a For Next or a Do While, take your pick once you understand the logic used.
Note that "Cells" takes two numbers - the row number then the column number. This is very handy when you're looping through a series of rows and columns and don't want to have to deal with addresses like A1 or C5.
This will loop through everything in the top table, but now you need to add an inner loop that will actually process the instructions. Add all of the code below after the While and before the Wend.
Finally, you need to add the rows to the Target. The trick here is to use the CurrentRegion property to figure out where the last row in the range is, then just add one to get the next blank row.
Dim targetFirstEmptyRow
' Look up the Current Range of cell A1 on target worksheet
targetFirstEmptyRow = targetSheet.cells(1,1).CurrentRegion.Rows + 1
Then to assign values don't use copy and paste, just assign the values directly. This will write the first row you have defined:
targetSheet.cells(targetFirstEmptyRow, 1).value = sourceSheet.cells(sourceRowIndex, 1).value
targetSheet.cells(targetFirstEmptyRow, 4).value = sourceSheet.cells(sourceRowIndex, 4).value
targetSheet.cells(targetFirstEmptyRow, 5).value = sourceSheet.cells(sourceRowIndex, 5).value
Then after you write out those three values you can get the next empty row by using this again (note that your sourceRowIndex hasn't changed):
targetFirstEmptyRow = targetSheet.cells(1,1).CurrentRange.Rows + 1
Using the cells(row, column) logic it's pretty easy to write the second row as well:
targetSheet.cells(targetFirstEmptyRow, 2).value = sourceSheet.cells(sourceRowIndex, 6).value
targetSheet.cells(targetFirstEmptyRow, 3).value = sourceSheet.cells(sourceRowIndex, 7).value
targetSheet.cells(targetFirstEmptyRow, 6).value = "Dev"
Adding the third row (when it's required) is nearly exactly the same as the second. However, you want to check to see if the third row is necessary:
If sourceWorksheet.cells(sourceRowIndex, 1) = 3 Then
' insert your third row here
End If
Here's the entire function in pseudo-code so you can piece it all together:
Set up worksheet variables
While loop through every Source row
Find next empty row in Target
Copy Row 1
Find next empty row in Target
Copy Row 2
If 3 rows
Find next empty row in Target
Copy Row 3
Increment Source Row Index
Wend
Finally, if you don't want to see the screen flashing (and you want to speed the code execution up a little) look into Application.Screenupdating to turn off screen redraw as this does its work. Just remember to turn it on again once you've finished processing everything.
First time poster long time reader.
My colleague and I have spent a while creating this code. Whilst it runs brilliantly for small data sizes, our full data set is two tables of 100k lines or so. We let it run for some 30-40 mins and it just grinds to a halt. We have no idea how to make it any faster.
The idea is that for every line in one table, we need to search the second table for a date closest to two days prior to the account date. We also find a date closest to 2 weeks after the date that is two days prior. The dates are sorted newest to oldest from top to bottom.
Once we have this range, we need to search another column to find the first Account ID that appeared within this date range. Once we know this row, we use it to look up two other cells in the row.
I imagine somehow doing it inside an array would be incredibly better but I have no idea how to get it to that level for what we're after. Potentially stick all of the dates within an array and figure out the array number and use those for the rows for the find later on?
Here's our code so far. I know our first problem is possibly because we have a loop that cycles through one table and feeds the account number and date into the function that does the work:
Function Find_Last(AccountNumber, AccountDate As Date)
'Function to find the first occurance of account number and associated quality within a two week range
Dim R As Range
Dim LastDiff1 As Date
Dim LastDiff2 As Date
Dim LastCell1 As Range, LastCell2 As Range
Dim SearchDate1
Dim SearchDate2
Dim Rng As Range
Dim DestSheet As Worksheet
Dim LastRow
Set DestSheet = Workbooks("Interim Referrals Report.xlsm").Worksheets("SA Wrap Up Data")
SearchDate1 = DateAdd("d", 14, AccountDate)
SearchDate2 = DateAdd("d", -2, AccountDate)
LastDiff1 = DateSerial(9999, 1, 1)
LastDiff2 = DateSerial(9999, 1, 1)
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For Each R In DestSheet.Range("A2:A" & LastRow)
If IsDate(R.Value) Then
'Do Nothing
If Abs(R.Value - SearchDate1) < LastDiff1 Then
Set LastCell1 = R
LastDiff1 = Abs(R.Value - SearchDate1)
End If
End If
If IsDate(R.Value) Then
'Do Nothing
If Abs(R.Value - SearchDate2) < LastDiff2 Then
Set LastCell2 = R
LastDiff2 = Abs(R.Value - SearchDate2)
End If
End If
Next R
'Find the CR account number within the designated range in the SA cricket
'data worksheet, looks from bottom of range up
With DestSheet.Range("L" & LastCell1.Row & ":L" & LastCell2.Row)
Set Rng = DestSheet.Cells.Find(What:=AccountNumber, After:=.Cells(LastCell1.Row), LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
'if there is a match, return the row number
If Not Rng Is Nothing Then
Find_Last = Rng.Row
Else
Find_Last = "No Match"
End If
End With
End Function
Can anyone help?
You are right that changing the loop to use an array will be much faster than looping a range.
Here's a version of your loop using a Variant Array. Untested, but should be close...
Dim Dat As Variant
Dim idx As Long
Dim idxLastCell1 As Long
Dim idxLastCell2 As Long
With DestSheet
' start array at row 1 to avoid confusing index offset
Dat = .Range("A1:A" & LastRow).Value
idxLastDiff1 = 2
idxLastDiff2 = 2
' Loop from row 2
For idx = 2 To UBound(Dat, 1)
If IsDate(Dat(idx, 1)) Then
If Abs(Dat(idx, 1) - SearchDate1) < Dat(idxLastDiff1, 1) Then
idxLastCell1 = idx
LastDiff1 = Abs(Dat(idx, 1) - SearchDate1)
End If
If Abs(Dat(idx, 1) - SearchDate2) < Dat(idxLastDiff2, 1) Then
idxLastCell2 = idx
LastDiff2 = Abs(Dat(idx, 1) - SearchDate2)
End If
End If
Next
Set LastCell1 = .Cells(idxLastCell1, 1)
Set LastCell2 = .Cells(idxLastCell2, 1)
End With
Simply substitute your existing loop with this code. It sets the same variables you use later in your code.