I try to line up columns from each sheet into a summary sheet. The Columns nymber in each sheet can vary and each have to be lined up to each other. I try with the following code:
Sub Create_Summary()
Dim sh As Worksheet, sumSht As Worksheet
Dim i As Long
Dim colCount As Long
Dim rowCount As Long
Sheets("Summary").Cells.ClearContents
Set sumSht = Sheets("Summary")
sumSht.Move after:=Worksheets(Worksheets.Count)
For i = 1 To Worksheets.Count - 1
colCount = sumSht.Columns.Count
rowCount = Worksheets(i).Rows.Count
Worksheets(i).Range("A:VV").Copy Destination:=sumSht.Cells(1,
colCount).End(xlToLeft).Offset(, 1)
Next i
sumSht.Columns(2).Delete
End Sub
This doesn't work properly due to the .Offset(, 1) I guess... I dont understand why I am not allowed to use .Offset(, colCount) because then I think it would look good. For some reason if I use .Offset(, i) (which make no sense to do) it's just OK and it can run. Both is a Long variables, so what make the difference and how can I fix this?
Thanks in advance...
To make this dynamic, consider:
getting the range of the detail you want to move for each sheet and storing this in detailRowCount and detailColCount
keeping an track of the used columns in Summary worksheet by incrementing the value for the number of columns pasted in per detailColCount.
Example code:
Option Explicit
Sub Create_Summary()
Dim sh As Worksheet, sumSht As Worksheet
Dim i As Long
Dim detailColCount As Long
Dim detailRowCount As Long
Dim summaryColCount As Long
Sheets("Summary").Cells.ClearContents
Set sumSht = Sheets("Summary")
sumSht.Move after:=Worksheets(Worksheets.Count)
summaryColCount = 1
For i = 1 To Worksheets.Count - 1
Set sh = Worksheets(i)
detailColCount = sh.Cells(1, 1).End(xlToRight).Column
detailRowCount = sh.Cells(1, 1).End(xlDown).Row
sh.Range(sh.Cells(1, 1), sh.Cells(detailRowCount, detailColCount)).Copy _
Destination:=sumSht.Cells(1, summaryColCount)
summaryColCount = summaryColCount + detailColCount
Next i
'sumSht.Columns(2).Delete <-- ?
End Sub
Related
I am hoping someone can share their knowledge and be of assistance.
I am trying to loop through DataSheet1, DataSheet2..... and take certain columns from each sheet.
I am sure this question has been asked before - my attempt at code is below.
I attempted to do it for one column but I got stuck in an infinite loop.
any help is greatly appreciated.
Sub SummarySheet()
Dim WKSheetSummarySheet As Worksheet, WKSheetDataSheet1 As Worksheet, WKSheetDataSheet2 As Worksheet, WKSheetDataSheet3 As Worksheet, WKSheetDataSheet4 As Worksheet
Dim LastRowSummarySheet As Long, LastRowDataSheet1 As Long, LastRowDataSheet2 As Long, LastRowDataSheet3 As Long, LastRowDataSheet4 As Long
Dim LastColSummarySheet As Long, LastColDataSheet1 As Long, LastColDataSheet2 As Long, LastColDataSheet3 As Long, LastColDataSheet4 As Long
Dim RangeSummarySheet As Range, RangeDataSheet1 As Range, RangeDataSheet2 As Range, RangeDataSheet3 As Range, RangeDataSheet4 As Range
Set WKSheetSummarySheet = ThisWorkbook.Worksheets("SummarySheet")
Set WKSheetDataSheet1 = ThisWorkbook.Worksheets("DataSheet1")
Set WKSheetDataSheet2 = ThisWorkbook.Worksheets("DataSheet2")
Set WKSheetDataSheet3 = ThisWorkbook.Worksheets("DataSheet3")
Set WKSheetDataSheet4 = ThisWorkbook.Worksheets("DataSheet4")
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlManual
End With
On Error Resume Next
LastRowSummarySheet = WKSheetSummarySheet.Cells(WKSheetSummarySheet.Rows.Count, 1).End(xlUp).Row
LastRowDataSheet1 = WKSheetDataSheet1.Cells(WKSheetDataSheet1.Rows.Count, 1).End(xlUp).Row
LastRowDataSheet2 = WKSheetDataSheet2.Cells(WKSheetDataSheet2.Rows.Count, 1).End(xlUp).Row
LastRowDataSheet3 = WKSheetDataSheet3.Cells(WKSheetDataSheet3.Rows.Count, 1).End(xlUp).Row
LastRowDataSheet4 = WKSheetDataSheet4.Cells(WKSheetDataSheet4.Rows.Count, 1).End(xlUp).Row
LastColSummarySheet = WKSheetSummarySheet.Cells(1, WKSheetSummarySheet.Columns.Count).End(xlToLeft).Column
LastColDataSheet1 = WKSheetDataSheet1.Cells(1, WKSheetDataSheet1.Columns.Count).End(xlToLeft).Column
LastColDataSheet2 = WKSheetDataSheet2.Cells(1, WKSheetDataSheet2.Columns.Count).End(xlToLeft).Column
LastColDataSheet3 = WKSheetDataSheet3.Cells(1, WKSheetDataSheet3.Columns.Count).End(xlToLeft).Column
LastColDataSheet4 = WKSheetDataSheet4.Cells(1, WKSheetDataSheet4.Columns.Count).End(xlToLeft).Column
Set RangeSummarySheet = Range(RangeSummarySheet.Cells(3, 2), RangeSummarySheet.Cells(LastRowSummarySheet, LastColSummarySheet))
Set RangeDataSheet1 = Range(RangeDataSheet1.Cells(5, 1), RangeDataSheet1.Cells(LastRowDataSheet1, LastColDataSheet1))
Set RangeDataSheet2 = Range(RangeDataSheet2.Cells(5, 1), RangeDataSheet2.Cells(LastRowDataSheet2, LastColDataSheet2))
Set RangeDataSheet3 = Range(RangeDataSheet3.Cells(5, 1), RangeDataSheet3.Cells(LastRowDataSheet3, LastColDataSheet3))
Set RangeDataSheet4 = Range(RangeDataSheet4.Cells(5, 1), RangeDataSheet4.Cells(LastRowDataSheet4, LastColDataSheet4))
Do Until IsEmpty(RangeDataSheet1(1))
RangeDataSheet1(1) = RangeSummarySheet(1)
Set RangeDataSheet1 = RangeDataSheet1.Offset(1, 0)
Set RangeSummarySheet = RangeSummarySheet.Offset(1, 0)
Loop
End Sub
I tried to decipher what you wanted to accomplish; if this code is not correct please clarify what you are trying to accomplish and provide and example of the data. This basic code below will loop through your four DataSheets copy the range from "A5" to the lastrow and lastcolumn, and then paste in the SummarySheet into the next empty row for each loop. Comments are added in the code.
Side note: when using the 'Equals' method, the source and destination range must be the same.
Sub ConsolidateSheetDataInSumSheet()
'This code will copy the range starting at "A5" to the lastrow and lastcolumn from each `DataSheet`,
'and paste to the next empty cell in `Column 2` in the 'SummarySheet'
Dim wsSum As Worksheet: Set wsSum = ThisWorkbook.Sheets("SummarySheet") 'Define the SummmarySheet variable
For x = 1 To 4 'Loop from 1 to 4 (the number for each datasheet)
With ThisWorkbook.Sheets("DataSheet" & x) 'DataSheet1, DataSheet2, etc.
'The next line sets the range from for each `DataSheet`, copies the range and
'pastes the copied range to the next empty cell in the `SummarySheet`
'the line is separated using the Dash, `_`, for ease of reading
.Range(.Cells(5, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column)).Copy _
wsSum.Cells(Rows.Count, 2).End(xlUp).Offset(1)
End With
Next x 'Go to next `DataSheet`
End Sub
I already have a filter macro that cleanses the data of the first sheet("RO") of the workbook, now i want to clean the second worksheet ("RSSI"), i thought that by declaring the second sheet as the actual worksheet might work but it still works on the first sheet.
Dim wsToFilter As Worksheet
Dim wbToFilter As Workbook
Set wbToFilter = Workbooks("2. Detalle_Transacciones_pendientes_rechazadas_MDM_27Ene20.xlsx")
Set wsToFilter = wbToFilter.Worksheets("Rechazos_SSI_2019")
Dim RowToTest2 As Long
For RowToTest2 = Cells(Rows.Count, 2).End(xlUp).row To 2 Step -1
With Cells(RowToTest2, 1)
If .Value <> "BATCH" _
Then _
Rows(RowToTest2).EntireRow.Delete
End With
Next RowToTest2
The code below first looks at one worksheet, then at another. I thought that's what you wanted. It retains your method of determining the rows to delete.
Dim wbToFilter As Workbook
Dim wsToFilter As Worksheet
Dim RowToTest2 As Long
Dim WsCounter As Integer
Set wbToFilter = Workbooks("2. Detalle_Transacciones_pendientes_rechazadas_MDM_27Ene20.xlsx")
' here the first worksheet is assigned to the variable WsToFilter
Set wsToFilter = wbToFilter.Worksheets("Rechazos_SSI_2019")
For WsCounter = 1 To 2
With wsToFilter ' all the following is executed on WsToFilter
' observe the leading periods which create the link
For RowToTest2 = .Cells(.Rows.Count, 2).End(xlUp).Row To 2 Step -1
With .Cells(RowToTest2, 1)
If .Value <> "BATCH" Then _
Rows(RowToTest2).EntireRow.Delete
End With
Next RowToTest2
End With
' now, for the second loop, the other worksheet is assigned
' to the variable WsToFilter
Set wsToFilter = wbToFilter.Worksheets("Rechazos_RO_2019")
Next WsCounter
Dim wsToFilter As Worksheet
Dim wbToFilter As Workbook
Set wbToFilter = Workbooks("2. Detalle_Transacciones_pendientes_rechazadas_MDM_27Ene20.xlsx")
Set wsToFilter = wbToFilter.Worksheets("Rechazos_SSI_2019")
With wsToFilter
.Range("A1").AutoFilter 1, "<>Batch"
.AutoFilter.Range.Offset(1).EntireRow.Delete
.AutoFilterMode = False
End With
Changed it into autofilter and worked perfectly, i took what Variatus wrote as a hint, so i modified my code like this.
I'm creating a concatenated key from data in each row and then adding it to a dictionary as well as the end column of the row.
For some reason, when just adding to the column or just adding to the dictionary, it works, but when I do both, it takes forever to run. Shouldn't adding a value to the end of a column (in bold below) increase time very marginally?
Dim unique_key
Dim sht
Set sht = ThisWorkbook.Worksheets("data")
Dim colNum
colNum = sht.Cells(2, sht.Columns.Count).End(xlToLeft).Column
For i = 2 To Rows.Count
unique_key = Concatenate(CLng(i), id_cols)
**Cells(CLng(i), colNum).Value = unique_key**
If dict.Exists(unique_key) Then
GoTo continue
Else
dict.Add unique_key, Cells(i, 10)
End If
continue:
Next i
Going to try and update your code:
Option Explicit
Public id_cols 'so you can use it between sub routines
'not sure if the below is part of a function or sub, so not listing
Dim unique_key as string, sht as worksheet, i as long, colNum as long, dict as scripting.dictionary
set dict = NEW scripting.dictionary
Set sht = ThisWorkbook.Worksheets("data")
with sht
colNum = .Cells(2, .Columns.Count).End(xlToLeft).Column
For i = 2 To .Rows.Count
unique_key = i & id_cols
.Cells(i, colNum).Value = unique_key
If NOT dict.Exists(unique_key) Then dict(unique_key) = .Cells(i, 10)
Next i
Couple things...
you are wanting to place the value in the last column (colNum) or last column +1?
what are you doing with the dictionary after it is created?
Make sure to qualify your references... that would be about the only hiccup i could see in your code
Beyond that, depending on what is in id_cols you might have an issue with how the key is being understood.
Edit1:
Realized i forgot to add what i earlier suggested... & not Concatenate. Updated.
For the life of me, I can't figure out how to loop a formula over columns and down rows. I put some code together that I thought would be on the right track:
Sub LoopAcrossColsRows()
Dim C As Integer
Dim R As Integer
Dim LastCol As Integer
Dim LastRow As Long
Dim lr As Long
Worksheets("Sheet1").Activate
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, 20).End(xlUp).Row
lr = Cells(Rows.Count, 1).End(xlUp).Row
For C = 2 To LastCol
For R = lr + 3 To LastRow
.Cells(R, C).FormulaR1C1 = “=SUMPRODUCT(--(R6C:R7C>=RC1), --(R6C:R7C<=(RC1+30))*R4C)"
Next R
Next C
End Sub
The formula is causing an expected list separator or ) error. The formula works when I insert it on my worksheet, so I do not know what could be going wrong. Thanks for all help in advance.
As an aside, is there anyway to create an input box that would prompt for a new sheet name, which would be reflected as the new sheet name in the Worksheets("Sheet1").Activate line, so that I wouldn't have to keep changing the sheet name in the vba code?
Thanks again,
You need to qualify the Cells property with an object
Your error message from the VB interface is due to the fact that your first quote mark is a left double quote and not a regular quote mark.
Try
Cells(R, C).FormulaR1C1 = "=SUMPRODUCT(--(R6C:R7C>=RC1), --(R6C:R7C<=(RC1+30))*R4C)"
And better than looping would be a routine that assigns the formula to a multicell range object.
Not Tested:
range(cells(lr+3,2),cells(lastrow,lastcol)).FormulaR1C1 = "=SUMPRODUCT(--(R6C:R7C>=RC1), --(R6C:R7C<=(RC1+30))*R4C)"
The line
.Cells(R, C)...
should probably be qualified:
ActiveSheet.Cells(R,C)...
Better yet, you should retain a reference to the appropriate worksheet in a variable, instead of depending on it being the active sheet for the length of the For loop:
Dim wks As Worksheet
Set wks=Worksheets("Sheet1")
...
For R = lr + 3 To LastRow
wks.Cells(R, C).FormulaR1C1 = “=SUMPRODUCT(--(R6C:R7C>=RC1), --(R6C:R7C<=(RC1+30))*R4C)"
Next R
...
Your aside is an entirely separate question and doesn't belong here, but consider using the Excel Application.Inputbox function, or the VBA Inputbox function.
I believe you need the code to be
Activesheet.Cells(R,C)...
If you don't want to use name to call worksheets, then use index
worksheet(1).cells(x,y)...
however this is only useful if you never change the order of worksheet. Because worksheet(1) always goes to the first sheet of the workbook.
also you can set a variable as worksheet and use that
Dim ws1 As Worksheet
'or set it = Worksheet(1)
Set ws1 = Worksheets("sheet"1)
ws1.cells(1,1) = "test"
For the name problem you can try this
Dim yourName as String
yourName = Application.InputBox("Enter name of worksheet")
worksheet(1).Name = yourName
EDITED:
Ok, so took a detailed look at your code. There are a couple of changes to make here.
The loop for "R" doesn't get triggered because lr+3 will always > LastRow
C and R in "Cells(R,C)" could be problematic --> varR and varC.
.Cells --> Activesheet.Cells
You define your last row variable twice "LastRow" & "lr"? I'm not sure why. (also see #6 below.
RC reference in .FormulaR1C1 to be bound by []
The End(xl[Up, ToLeft]) method could miss the full size of the data set if it is not contiguous. "a1" can be replaced with different row/column ranges to constrain the variable. (Sorry for not knowing the source of this code, but have been using this for a while)
I'm not sure if the code will run seamless, or will loop exactly the range you need. But give it a go and see if it works. Hopefully the principle will guide you to a solution:
Sub LoopAcrossColsRows()
Dim varC As Integer
Dim varR As Integer
Dim LastCol As Integer
Dim LastRow As Long
Dim lr As Long
Worksheets("Sheet1").Activate
LastRow = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
LastCol = Cells.Find("*", [a1], , , xlByColumns, xlPrevious).Column
For varC = 2 To LastCol
For varR = (LastRow + 3) To LastRow Step -1
Worksheets("Sheet1").Cells(varR, varC).FormulaR1C1 = "=SUMPRODUCT(--(R6C:R7C1>=RC1),--(R6C:R7C1<=(RC1+30))*R4C)"
Next varR
Next varC
End Sub
UPDATE:
Alright, so i used the following code and it does what i need it to do, i.e check if the value is 0 and if its is, then delete the entire row. However i want to do this to multiple worksheets inside one workbook, one at a time. What the following code is doing is that it removes the zeros only from the current spreadsheet which is active by default when you open excel through the VBA script. here the working zero removal code:
Dim wsDCCTabA As Excel.Worksheet
Dim wsTempGtoS As Excel.Worksheet
Set wsDCCTabA = wbDCC.Worksheets("Login")
Set wsTempGtoS = wbCalc.Worksheets("All_TemporaryDifferences")
Dim LastRow As Long, n As Long
LastRow = wsTempGtoS.Range("E65536").End(xlUp).Row
For n = LastRow To 1 Step -1
If Cells(n, 5).Value = 0 Then
Cells(n, 5).EntireRow.Delete
End If
Next
What am i doing wrong? when i do the same thing for another worksheet inside the same workbook it doesnt do anything. I am using the following code to remove zeros from anohter worksheet:
Set wsPermGtoS = wbCalc.Worksheets("All_PermanentDifferences")
'delete rows with 0 description
Dim LastRow As Long, n As Long
LastRow = wsPermGtoS.Range("E65536").End(xlUp).Row
For n = LastRow To 1 Step -1
If Cells(n, 5).Value = 0 Then
Cells(n, 5).EntireRow.Delete
End If
Next
Any thoughts? or another way of doing the same thing?
ORIGINAL QUESTION:
I want to delete all the rows which have a zero in a particular column. I am using the following code but nothing seems to happen:
CurrRow = (Range("E65536").End(xlUp).Row)
For Count = StartRow To CurrRow
If wsDCCTabA.Range("E" & Count).Value = "0" Then
wsDCCTabA.Rows(Count).Delete
End If
Next
StartRow contains the starting row value
CurrRow contains the row value of the last used row
See if this helps:
Sub DelSomeRows()
Dim colNo As Long: colNo = 5 ' hardcoded to look in col 5
Dim ws As Worksheet: Set ws = ActiveSheet ' on the active sheet
Dim rgCol As Range
Set rgCol = ws.Columns(colNo) ' full col range (huge)
Set rgCol = Application.Intersect(ws.UsedRange, rgCol) ' shrink to nec size
Dim rgZeroCells As Range ' range to hold all the "0" cells (union of disjoint cells)
Dim rgCell As Range ' single cell to iterate
For Each rgCell In rgCol.Cells
If Not IsError(rgCell) Then
If rgCell.Value = "0" Then
If rgZeroCells Is Nothing Then
Set rgZeroCells = rgCell ' found 1st one, assign
Else
Set rgZeroCells = Union(rgZeroCells, rgCell) ' found another, append
End If
End If
End If
Next rgCell
If Not rgZeroCells Is Nothing Then
rgZeroCells.EntireRow.Delete ' deletes all the target rows at once
End If
End Sub
Once you delete a row, u need to minus the "Count" variable
CurrRow = (Range("E65536").End(xlUp).Row)
For Count = StartRow To CurrRow
If wsDCCTabA.Range("E" & Count).Value = "0" Then
wsDCCTabA.Rows(Count).Delete
' Add this line:
Count = Count - 1
End If
Next
I got it. For future reference, i used
ActiveWorkbook.Sheets("All_temporaryDifferences").Activate
and
ActiveWorkbook.Sheets("All_Permanentdifferences").Activate
You don't need to use ActiveWorkbook.Sheets("All_temporaryDifferences").Activate. In fact if the ActiveWorkbook is different from wbCalc you would get an error.
Your real problem is that you are using an unqualified reference to Cells(n, 5).Value. Unqualified means that you aren't specifying which sheet to use so it defaults to the active sheet. That may work sometimes but it is poor code. In your case it didn't work.
Instead you should always use qualified references. wsTempGtoS.Cells(n, 5).Value is a qualified reference. wsTempGtoS specifies which worksheet you want so VBA is not left guessing.
Dim LastRow As Long, n As Long
LastRow = wsTempGtoS.Range("E65536").End(xlUp).Row
For n = LastRow To 1 Step -1
If wsTempGtoS.Cells(n, 5).Value = 0 Then
wsTempGtoS.Cells(n, 5).EntireRow.Delete
End If
Next
This: CurrRow = (Range("E65536").End(xlUp).Row) is also an unqualified reference. Instead it should be CurrRow = wsDCCTabA.Range("E65536").End(xlUp).Row.