I have a range of cells where each cell contains a different value (Call this range1) and looks against a template file.
I copy all sheets of the template file (3 sheets), these first 2 steps work.
I need to loop from the bottom to top and look on all 3 sheets to delete all rows where the value in a column (Call this range2) <> the value in Range1.
I anticipate creating three loops, but the above premise is the same for all loops, just with different ranges. (I know a lastRow code could be used, but I'm not confident in having the last row be different for 3 sheets with varying row counts.)
Here is an example from the first loop I wrote, which runs Top -> bottom and ends up skipping every other line because it deletes the active row, cells shift up a row, then moves on to the next row.
BrNoRng = range1 described above.
Dim x As Integer
Dim BrNo As String
Dim BrNoRng As Range
Dim c As Range, rng
Set BranchRange = Range("B2:B35") 'this range is in separate file
Set BrNoRng = Range("B2") ' ^^ this range is in separate file
BrNo = BrNoRng.Value
'******Begin Loop 1***************
For x = 1 To 34 'Loop 1 is fine to run top -> bottom
'******Begin Loop 2****************** 'Loop 2 Needs to run Bottom -> Top
Sheets1.Activate 'Not actual name of the sheet, used as a placeholder sheet name,
'this is where the rows need to delete
Set rng = Range("C3:C2500")
For Each c In rng.Rows
If c.Value <> BrNoRng.Value Then
c.Value.EntireRow.Delete
End If
Next c
'*****End loop 2**********
Next x
'*****End Loop 1*************
Related
My question is: How do I create a loop to write data to an output range in a way that allows me to both add rows of data to the output range, and also enter data in new columns of existing output rows?
The simplified setup is this. I have a list of source folder names in A5:A14, and the number of items in each folder in B5:B14. The goal is to determine the makeup of all possible output “sets” and write each possible set to a row in output range D18:Lx, with an output set being something like: 1 item from Folder 1; 2 items from Folder 2; etc. (so C18 would be “1”, D18 would be “2”, etc.). Each source folder name contains a “tag” between brackets that indicates how many items from that folder must be included in any output set. In this screenshot of the worksheet, the green cells are the source data, the light blue cells are the output row/column headers, and the dark blue cells are the output item quantities per folder (which is where I need help).
My code already parses each folder name and (1) enters the row/column headers, (2) calculates the number of new rows that must be added to the output after parsing each folder name, and (3) calculates the running total number of output rows and columns after parsing each folder name. But I am stuck figuring out to go back and write the dark blue output area. The code needs to:
Loop through the source folder cells, which represent the column headers in the output range (screenshot C17:L17). Based on the value of each source cell, I already have the formula to determine how many new output rows are required (RowsNew), the running total of output rows (RowsCount), and what the contents of the output cells should be.
Based on the content of the first source cell, somewhere between 1-9 rows of data will be written to the output range. When the first source cell is parsed, the only data that will entered in the output area will be in the first column (screenshot C18-Cx).
For the second and all subsequent source cells, it is possible that no new rows will be added to the output range (see 3a below). It is also possible that rows will be added, with the number of new rows equal to a formula (see 3b below). In both of these situations, data will be added to the incremental column of the existing output rows.
---- 3a. If RowsNew=0 or 1 for a source cell, it means no new rows are required. But we still need at least one value to be written to all existing rows of the output range, entered in the furthest-right blank output column (the code already knows this column number). So if the first source cell resulted in the value “1” being entered in C18 and RowsNew =1 for the second source cell, we need a value entered in D18. The third source cell would need (if RowsNew=1 for that cell) a number written to E18, and so on.
---- 3b. If RowsNew>1 then new output rows ARE required, and things get trickier. We need to add new output rows equal to RowsCount * RowsNew – RowsCount. So if RowsNew=2, then all existing rows must be duplicated, with the first half (the original rows) receiving a “1” in the furthest-right blank column, and the second half (the new rows) receiving a “2”. If RowsNew=3, then all existing rows must be duplicated twice, with the first third (the original rows) receiving a “1” in the furthest-right column, the second third receiving a “2” and the last third receiving a “3”. And so on, since the maximum possible value of RowsNew=9.
Any pointers greatly appreciated! Thanks.
Dim ws As Worksheet
Dim c As Range 'used to reference any cell in a range
Dim Folders As Range 'named worksheet range with folder names
Dim Items As Range 'named ws range showing number of items in each folder
Dim OutputStart As Range 'named ws cell that is 1 cell above and left of output range
Dim OutputRange As Range 'named ws range where output will be placed
Dim ItemComboRange As Range 'named ws range where actual Item counts are entered (subset of OutputRange)
Dim ItemCount As Integer 'count of Items; used in combination calcs
Dim RowsNew As Integer 'number of new rows to add to output area
Dim RowCount As Integer 'running count of number of rows needed for output
Dim ColumnCount As Integer 'running count of number of columns needed for output (not counting first column that just says "Row1", etc.)
Dim Tag As String 'the text in each folder name between the brackets
Dim Min As Integer 'used to calc min number of Items per folder
Dim Max As Integer 'used to calc max number of Items per folder
Dim x As Integer 'general counting variable
'Setup
Set ws = ActiveSheet
Set Folders = ws.Range("B5:B14") 'folder names pre-entered here
Set Items = ws.Range("C5:C14") 'count of Items per folder pre-entered here
Set OutputStart = ws.Range("B17")
Set OutputRange = ws.Range("B17:L18")
'Set up
OutputRange.ClearContents
ColumnCount = 0
RowCount = 1 'will always be at least one row required in output
'Loop through each folder listed in Folders range, enter column headers, count rows required
For Each c In Folders
If c.Value = "" Then GoTo NextFolder 'skip this row if empty
'Get folder name & Item count in folder, write headers
ColumnCount = ColumnCount + 1 'running folder count; each folder equates to a column of output
OutputStart.Offset(0, ColumnCount).Value = c.Value 'enter folder name in top row of output
'extract tag between brackets
FromPos = InStr(c, "[")
ToPos = InStr(c, "]")
Tag = Mid(c, FromPos + 1, ToPos - FromPos - 1)
'grab low and high Item count (if any) and calc rows needed
If InStr(1, Tag, "ALL") > 0 Then 'detailed code omitted for clarity
ElseIf InStr(1, (Tag), "-") > 0 Then
Min = CInt(Left(Tag, 1))
Max = CInt(Right(Tag, 1))
RowsNew = RowCount * (Max - Min + 1) - RowCount 'update new output rows needed
RowCount = RowCount + RowsNew 'update total output rows needed
ElseIf Tag = "1" Then 'detailed code omitted for clarity
ElseIf Tag > 1 And Tag <= 9 Then 'detailed code omitted for clarity
Else 'This means there is a malformed tag
MsgBox "I have detected a malformed tag. Macro will now exit. All hell is about to break loose. Hope you saved the file before you ran this code!"
Exit Sub
End If
NextFolder:
Next c
'Write output data
'Define output ranges based on row & column counts
Set OutputRange = Range(OutputStart, OutputStart.Offset(RowCount, ColumnCount))
Set ItemComboRange = Range(OutputStart.Offset(1, 1), OutputStart.Offset(RowCount, ColumnCount))
'Write row headers
For x = 1 To RowCount
OutputStart.Offset(x, 0).Value = "Row" & x
Next x
x = 0 'reset counter
'NEXT STEPS: How to write data to output range (ItemComboRange)?
End Sub
I have written VBA code that copies a filtered table from one spreadsheet to another. This is the code:
Option Explicit
Public Sub LeadingRetailers()
Dim rngRows As Range
Set rngRows = Worksheets("StoreDatabase").Range("B5:N584")
With rngRows
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("LeadingRetailersAUX").Range("B2")
End With
Sheets("Leading Retailers").Activate
End Sub
The filter is applied before the code is ran and then the code selects the visible cells and copies them so as to get only those rows that passed the filter.
In the filtered table to be copied I have, in column L of the range, a certain set of names, some of which are repeated in several rows.
I would like to add to the code so that it only copies one row per name in column L. In other words, I would like the code to copy only the first row for each of the names that appears in Column L of the filtered table.
Pehaps something like this can help you. Code will loop through your rows (5 to 584). First it checks if row is hidden. If not, will check if the value in column "L" is already in the Dictionary. If it is not, it will do two things: copy the row to Destination Sheet, and add the value to the Dictionary.
Option Explicit
Public Sub LeadingRetailers()
Dim d As Object
Dim i As Long
Dim k As Long
Set d = CreateObject("scripting.dictionary")
i = 2 'first row of pasting (in "LeadingRetailersAUX")
For k = 5 To 584
If Not (Worksheets("StoreDatabase").Rows(k).RowHeight = 0) Then 'if not hidden
If Not d.Exists(Worksheets("Hoja1").Cells(k, 12).Value) Then 'if not in Dictionary
d.Add Worksheets("StoreDatabase").Cells(k, 12).Value, i 'Add it
Worksheets("LeadingRetailersAUX").Cells(i, 2).EntireRow.Value = Worksheets("StoreDatabase").Cells(k, 1).EntireRow.Value
i = i + 1
End If
End If
Next
End Sub
You could apply another filter to the table to only show the first occurrence of each set of names and then run your macro as usual. See this answer:
https://superuser.com/a/634284
I've set up a two-dimensional array, and I want to count the number of filled cells in column H for each trial in each block. I then want to print the number of filled cells next to the last row of data for each trial, into column T.
The problem I'm getting is that when I try to run the macro, Excel stops responding, and after restarting, I get the error message in the title.
Here is the code:
Sub dotcountanalysis2()
' create multidimensional array
Dim Participant() As Variant
Participant = Worksheets("full test").Range("A7", Range("S:S")).Value
Dim Block As Variant
Block = Columns(2)
Dim Trial As Variant
Trial = Columns(3)
' define column H as boolean variable
Dim Pressed As Boolean
Pressed = True
' begin analysis after practice trials
For Each Block In Participant
For Each Trial In Participant
pressedcount = Range("H:H").Cells.SpecialCells(xlCellTypeConstants).Count
If Cells(, 8) = Pressed Then
Range("T:T").Value = pressedcount
End If
Next Trial
Next Block
End Sub
The error is on line:
pressedcount = Range("H:H").Cells.SpecialCells(xlCellTypeConstants).Count
I'm also not sure that my syntax is correct to make it count for each trial, as I have tried stepping into the code, and it gives the total number of filled cells in column H (562), and prints it in every cell in column T. I think it's also going way past the 7011 rows of data I have, to the maximum possible number of rows.
Here is a sample of my data
The most relevant problem is probably the fact that you create a huge variant array of values and then loop two times through it's values.
The Participant array contains 1048576*19 = 19922944 values. (assuming 1048576 rows in your sheet)
Now you loop through these values and for every value you loop through each value again, giving you 19922944*19922944 = 396923697627136 iterations. So that's why excel doesn't respond.
However, within each iteration, you don't even use the value...?
If you want to calculate that number of Pressed in column H and write that number to column T, why would you load all values of columns A to S into the array?
Here is what I would do in VBA
Dim pressedCount As Long
Dim myCell As range
Dim pressedRange As range
With Worksheets("full test")
pressedCount = Application.WorksheetFunction.CountA(.Columns("H"))
If pressedCount = 0 Then Exit Sub 'make sure there are cells or else the next line will fail
Set pressedRange = .Columns("H").SpecialCells(xlCellTypeConstants)
For Each myCell In pressedRange.Cells 'only loop through the cells containing something
.Cells(myCell.Row, "T").Value = pressedCount
Next myCell
End With
I used the With block so I don't have to write the sheet before every range which you should because otherwise it assumes you mean the active sheet.
Note that this assumes that there can be no other values than "Pressed" in column H, not even a header. If there is a header, start at row 2 and use .Range(.Cells(2, "H"), .Cells(.Rows.Count, "H")) instead of .Columns("H")
However this could also be achieved using a Formula like =IF($H7="Pressed",COUNTA(H:H),"")
I'm using macros to quickly search a large table of student data and consolidate it into a single cell for use in seating plans (I'm a teacher). Most of it works but I have a problem with selecting just the data I need.
Steps:
1. Remove data.
2. Run a formula to check if students fit into particular groups and consolidate their information
3. Format
Different subjects and year groups have different layouts for their data and so this step is causing me problems. I've tried using absolute cell references in step 2 but this doesn't work as sometimes the information that should be in column D is in column E etc.
What I want to be able to do is have a macro that checks the first value in the column (ie the title) and if it doesn't match one of a predetermined list delete the whole column along with it's data.
Dim rng As Range
For Each rng In Range("everything")
If rng.Value = "Test" Or rng.Value = "Test1" Then
rng.EntireColumn.Hidden = True
End If
I think I could use something like this if I could change the output from hiding columns to deleting them?
re: What I want to be able to do is have a macro that checks the first value in the column (ie the title) and if it doesn't match one of a predetermined list delete the whole column along with it's data.
To delete all columns NOT WITHIN the list:
Sub del_cols()
Dim c As Long, vCOL_LBLs As Variant
vCOL_LBLs = Array("BCD", "CDE", "DEF")
With Worksheets("Sheet7") '<~~ set this worksheet reference properly!
For c = .Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsError(Application.Match(.Cells(1, c), vCOL_LBLs, 0)) Then
.Columns(c).Delete
End If
Next c
End With
End Sub
To delete all columns WITHIN the list:
Sub del_cols()
Dim v As Long, vCOL_LBLs As Variant
vCOL_LBLs = Array("BCD", "CDE", "DEF")
With Worksheets("Sheet7") '<~~ set this worksheet reference properly!
For v = LBound(vCOL_LBLs) To UBound(vCOL_LBLs)
Do While Not IsError(Application.Match(vCOL_LBLs(v), .Rows(1), 0))
.Cells(1, Application.Match(vCOL_LBLs(v), .Rows(1), 0)).EntireColumn.Delete
Loop
Next v
End With
End Sub
This site already has something similar: Copy and insert rows based off of values in a column
but the code doesn't take me quite where I need to go, and I haven't been able to tweak it to make it work for me.
My user has a worksheet with 4 columns, A-D. Column A contains specific contract numbers, column B is blank, column C has part numbers, and column D has the entire range of contract numbers. My user wants to count the number of times the entire range contract numbers has duplicates so I entered the formula =countif($D$2:$D$100000,A2) in cell E2 and copied down, giving me the number of times the specific contract in column A appears in column D. The numbers range from 1 to 11 in this workbook but the number may be higher in other workbooks this method will be used in.
The next thing I need to do is to enter blank cells below all values in column E that are greater than 1, very much like the example in the previously asked question. I then also need to copy in the same row and insert copied cells exactly to match in the same row in column A. Example: Cell E21 has the number 5 so I need to shift cells in column E only so that there are 4 blanks cells directly below it. In column A, I need to copy cell A21 and insert copied cells in four rows directly below.
Just trying to get the blank cells to insert has been a trial, using the code as given in the previous question.
Dim sh As Worksheet
Dim lo As ListObject
Dim rColumn As Range
Dim i As Long
Dim rws As Long
Set sh = ActiveSheet
Set lo = sh.ListObjects("Count")
Set rColumn = lo.ListColumns("Count").DataBodyRange
vTable = rColumn.Value
For i = rColumn.Rows.Count To 1 Step -1
If rColumn.Cells(i, 1) > 1 Then
rws = rColumn.Cells(i, 1) - 1
With rColumn.Rows(i)
.Offset(1, 0).Resize(rws, 1).Cells.Insert
.EntireRow.Copy .Offset(1, 0).Resize(rws, 1).Cells
.Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True
End With
End If
Next
I would be very grateful for any help as I have been fighting with this monster for a week.
While this is indeed possible to do, it might be a good idea to look into moving the list of all contract numbers from column D to a different sheet. Even though it is quite simple to loop through a range and insert rows based on cell values - it'll also create holes in columns D and E.
Here's code for simply adding the rows and copying the values as you specified.
Sub Main()
'---Variables---
Dim source As Worksheet
Dim startRow As Integer
Dim num As Integer
Dim val As String
Dim i As Long
'---Customize---
Set source = ThisWorkbook.Sheets(1) 'The sheet with the data
startRow = 2 'The first row containing data
'---Logic---
i = startRow 'i acts as a row counter
Do While i <= source.Range("E" & source.Rows.Count).End(xlUp).Row
'looping until we hit the last row with a value in column E
num = source.Range("E" & i).Value 'Get number of appearances
val = source.Range("A" & i).Value 'Get the value
If num > 1 Then 'Number of appearances > 1
Do While num > 1 'Create rows
source.Range("A" & i + 1).EntireRow.Insert 'Insert row
source.Range("A" & i + 1) = val 'Set value
num = num - 1
i = i + 1 'Next row
Loop
End If
i = i + 1 'Next row
Loop
End Sub
Of course you could also remove the holes from column D after inserting the new rows and modify the formula in column E so that it remains copyable and doesn't calculate for the copied rows.
Generally it makes things easier if a single row can be thought of as a single object, as creating or deleting a row only affects that one single object. Here we have one row represent both a specific contract and a contract in the all contracts list - this could end up causing trouble later on (or it could be totally fine!)