New to VBA, and I'm trying to create multiple ranges or arrays based on a criteria in a column, then place those in a separate worksheet. The issue is that this code has to work for several different data sets. So one data sat will look something like
this, but with far more data points ( around 10,000 for each data set).
So what I'm trying to do is, for each group of 1's in the state column, create a range/array, then move the corresponding time and data in a new worksheet. So for the example I have, there would be 3 new worksheets, with the first new worksheet containing range("A2:B5"), the second one containing range("A10:B12"). With each data set, the state column changes and the number of new worksheets can also vary.
I have looked through this site, and the closest I have found to my needs is Creating Dynamic Range based on cell value, but it has a known number of ranges. I quite honestly have no idea how to accomplish what I need. I've been trying to make a while loop inside of a if then loop inside of a for each loop, but can't make it work.
Any help would be greatly appreciated! Been banging my head for hours now.
this should help you:
Option Explicit
Sub main()
Dim area As Range
With Sheets("myDataSheet") '<--| reference your sheet (change "myDataSheet") to your actual sheet name
With .Range("C1", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its columns A:C range form row 1 down to last column A not empty row
.AutoFilter Field:=3, Criteria1:="1" '<--| filter referenced range on its 3rd column (i.e. "State") with 1
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filterd cells other than header
For Each area In .Resize(.Rows.Count - 1, 2).Offset(1).SpecialCells(xlCellTypeVisible).Areas '<--| loop through filtered range (skipping header) 'Areas'
area.Copy Sheets.Add(Sheets(Sheets.Count)).Range("A1") '<--| copy current 'Area' into new sheet
Next area
End If
End With
.AutoFilterMode = False
End With
End Sub
Related
I am looking for a way to generate a Set with two given range values.
For example, in my code, I have the following :
Set myList = FindAll(columnValue, Sheet2.Range("ColumnName"))
Set advisorFound = myList.Offset(, -2)
What i would like to do is be able to FindAll with two range values such as :
Set myList = FindAll(columnValue, Sheet2.Range("ColumnName"), anotherColumnValue, Sheet2.Range("anotherColumnName"))
However, I am aware that the FindAll function is not what I am looking for since it only takes up to two parameters and the rest of the code wouldn't make sense either if I was using that (the offset wouldn't work).
My end goal would be to : get a set of rows that contain both of the range restrictions, and i would simply like to have access to a row in this set that has a minimal value in another column (compared to other rows found)
I have looked up the documentation (https://msdn.microsoft.com/en-us/library/office/ff839746.aspx) but I can't seem to find what I am looking for. Thanks in advance, I appreciate your help :)
you could use AutoFilter():
With Worksheets("Sheet2") '<--| reference your data sheet
With .Range(.Range("ColumnName"), .Range("anotherColumnName")) '<--| reference its range ranging between two named ranges
.AutoFilter Field:=.Parent.Range("ColumnName").Column - .Columns(1).Column + 1, Criteria1:=columnValue '<--| 1st filter on first named range
.AutoFilter Field:=.Parent.Range("anotherColumnName").Column - .Columns(1).Column + 1, Criteria1:=anothercolumnValue '<--| 2nd filter on 2nd named range
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filtered cell then
With Intersect(.Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow, .Columns(1).Offset(, -2)) '<--| reference cells two columns to the left of the lower column index named range filtered ones
Set myList = Intersect(.Find(what:=WorksheetFunction.min(.Cells), lookat:=xlWhole, LookIn:=xlValues).EntireRow, .Parent.UsedRange) '<-- set the row "used" range with the minimum value in the referenced cells
End With
End If
End With
.AutoFilterMode = False
End With
I am new to VBA and I'm trying to write a Macro in Excel that copies a table to another table and then deletes lines where a cell is equal to the value "0".
I have a table as follows:
I want the table to look like this:
Can anyone help me?
The following will copy data from a table in Sheet1 to Sheet2 where the second column is not 0 - using the table's Autofilter.
I had to add a 1 second application.wait to allow the filter to be applied before copying. This might need increasing depending on table size. Perhaps someone else could help with a more robust method of waiting for the filter to apply..?
Dim source_sheet As Worksheet
Dim destination_sheet As Worksheet
Set source_sheet = Sheets("Sheet1")
Set destination_sheet = Sheets("Sheet2")
With source_sheet.ListObjects("Table1").Range
.AutoFilter Field:=2, Criteria1:="<>0"
Application.Wait 1
.Copy Destination:=destination_sheet.Range("A1")
.AutoFilter Field:=2
End With
It's worth mentioning that the output to Sheet2 is not in a true table form. However, it shouldn't be tricky to record a macro where you convert it to a table to gain that piece of code too.
To preface this, I have very little experience in Excel VBA, but have used some VBA in Access.
I have a file which may contain multiple values in a single cell that need to be extracted out onto individual rows, and then have the data in multiple columns from the source row re-associated with the extracted values.
The multiple values in the single cell that need to be extracted are always in a uniform format. The cell may contain any number of sets of (), but the value I need to extract is always between the 2nd : and the closing ). This is the 'Identifier'.
For example:
(00050008009:STC:363711188)(00040022506:NYC:652263975)
Would need to extract these values onto individual rows:
363711188
652263975
All remaining values from the Source Row the value was extracted from then need to be re-associated with the value.
For example, my file may look like this:
Original File Format
I then need the file to appear as follows, on a new tab:
New File Format
I believe that a module making use of a loop, or multiple loops, is likely what is needed, but I have no idea of how to go about doing this in Excel. I'm open to all solutions. Any help is greatly appreciated! Thank you!
Without writing it for you, here are some pointers to get you started.
You'll need to loop through each cell in the column that contains the information you're looking for. For this, look into Worksheet.Range.
As you go through each cell, you'll need to examine the data that is actually entered into that cell. Using the Worksheet.Range.Value you can extract the contents of the cell.
Use excels string functions to parse the cell value into the values your looking for. Ex: InStr, InStrRev, etc... See this link for your options and usage for each function.
Finally you'll need to insert a row for each value that you find. Lookup Worksheet.Rows.Insert.
This should be the basic framework for what you need to do.
you may want to start with this code:
Option Explicit
Sub main()
Dim myArr As Variant
Dim cell As Range
Dim iRow As Long, nArr As Long
With Worksheets("batches").Range("A1").CurrentRegion '<--| change "batches" with your actual sheet name
For iRow = .Rows.Count To 2 Step -1 '<--|loop through data rows backwards, not to process rows multiple times
Set cell = .Cells(iRow, 3) '<--| 3rd column of current row is being processed
cell = Mid(cell, 2, Len(cell) - 2) '<--|get the cell value between first and last bracket
myArr = Split(cell, ")(") '<--|parse the resulting string with ")(" as delimiter and obtain and array
nArr = UBound(myArr) '<--| calculate the array size
If nArr > 0 Then '<--| if more than one element in array...
With .Rows(iRow) '<--|... then refer to entire current row
.Offset(1).Resize(nArr).Insert '<--| ...insert n-1 rows...
.Resize(nArr + 1).Value = .Value '<--|...duplicate current row into newly inserted ones
End With
cell.Resize(nArr + 1).Value = Application.Transpose(myArr) '<--|fill 3rd column of current and newly inserted rows with array elements
End If
Next iRow
For iRow = 2 To .Rows.Count '<--|loop through data rows
With .Cells(iRow, 3) '<--| 3rd column of current is being processed
.Value = Right(.Value, Len(.Value) - InStrRev(.Value, ":")) '<--| "finish" it
End With
Next iRow
End With
End Sub
As per your example, it assumes that your data start from cell "A1" and there's no blank row or column between it and the bottom-right cell of your data
Working on Microsoft Visual Basic Application Edition 7.1 in Excel 2013
Data are on columns from A to D, rows' number varies from time to time. I would like to delete all rows for which column B's value doesn't start with LCR (and also I would like not to bore with a for...next loop).
Something like:
Columns("B:B").AutoFilter Field:=1, Criteria1:="<>LCR*"
Selection.Delete
Unfortunately, this code deletes heading row (row number 1) and I don't want.
I tried to store row number 1 elsewhere in a range variable, but it doesn't work (run-time error '424')
Set r1 = Range("A1:D1")
r1.Copy
Columns("B:B").AutoFilter Field:=1, Criteria1:="<>LCR*"
Selection.Delete
With Range("A1:D1")
.Insert Shift:=xlDown
.Select
.Value = r1.Value
End With
How can I tell the filter to start from row number two (or how can I correctly store content of row number one so to paste it after deletion by filter)?
Thanks in advance for your help
Define your range for deleting as Range(Cells(2,2),Cells(ActiveSheet.UsedRange.Rows.Count,2)) (To replace the Selection call). This will delete everything except for the first cell in the column
Edit to avoid excel prompt: Range(Cells(2,2),Cells(ActiveSheet.UsedRange.Rows.Count,2)).EntireRow
in a more complete way you could go like this
Sub main()
With Worksheets("MyWantedSheet") '<--| always specify full worksheet reference (change "MyWantedSheet" with your actual sheet name)
With .Columns("B:B") '.Resize(.Cells(.Rows.Count, "B").End(xlUp).Row) '<--| refer to wanted column range down to its last non empty cell
.AutoFilter '<--| remove possible preeeding autofilter filtering
.AutoFilter Field:=1, Criteria1:="<>LCR*" '<--| apply current filtering
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if there are visible cells other than the "header" one
.Resize(.Parent.Cells(.Parent.Rows.Count, "B").End(xlUp).Row - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '<--|delete visible rows other than the first ("headers") one
End If
End With
.AutoFilterMode = False '<--| remove drop-down arrows
End With
End Sub
I'm stuck on how to structure a piece of code that:
Loops through all worksheets that begin with the number 673: (e.g. 673:green, 673:blue)
Selects the data in these worksheets from row 5 up until the last row with data - code that works for this (generously provided by another user) is
Dim report As Worksheet
Set report = Excel.ActiveSheet
With report
.Range(.Cells(5, "K"), .Cells(.Rows.Count, "K").End(xlUp)).EntireRow.Select
End With
Select the "Colours" worksheet
Paste the rows at the next available blank row. There could be up to 40/50 worksheets which will have data pasted into the "Colours" worksheet so I need the data added to the next available line.
Thank you in advance.
Loop over the sheets in the workbook and check their names
For Each sheet in ActiveWorkbook.Worksheets
If Instr(sheet.Name,"673")>0 Then
...
End If
Next
Good, but you're going to want to copy.
Selection.Copy
Just select.
Worksheets("Colours").Select
Find the last row then go to the next. The row is found by finding the first populated row from the bottom up. Note I used explicit sheet references, which is unnecessary since you selected the sheet already. This is better form, however, if you will be manipulating data on multiple sheets in your code.
lastRow = Worksheets("Colours").Cells(Worksheets("Colours").rows.count,1).End(xlUp).Row
Worksheets("Colours").Cells(lastRow + 1, 1).Select
Activesheet.Paste