For Loop to Copy Rows on a Separate Tab - excel

I have tried so many ways to make this work and its just not! j is the # of tabs its searching through (TailValue is an arraylist.Tested & works). k is the # of rows its supposed to be searching (Starting on Row 2 ending on Row 12). WantedDate is a text box for the date to search.
What I need it to do: Go through each tab. Find any date that matches the WantedDate (Only search Rows A2:A12). Copy the entire row and either paste it or insert it on the 2nd Row of the Mx EOD Tab
Every time I get it to atleast kind of function it pulls a random rows on each tab and/or it pulls the wrong date and inserts it on the MX EOD Tab twice.
If the "If Statement" needs an "Else" (If the date does not match the wanted date) I need it to move to the next row in the range and compare. There can be multiple rows with this date. Thank you for any and all help!!
For j = 0 To 20 'Or to LastRow (Cant figure out how to get the last row with text)
For k = 2 To 15 'Or to LastRow ("")
If Worksheets(TailValue(j)).Cells(k, 1).Value = WantedDate Then
Worksheets(TailValue(j)).Rows(ActiveCell).EntireRow.Copy
Worksheets("Mx EOD").Activate
Rows(2).Insert
End If
Next k
Next j

Related

Ignoring specific rows with VBA Excel

I have a table in Excel like such, where the number of rows will vary each day:
Column A
Column B
Column C
Cell 1
Cell 2
Show
Cell 3
Cell 4
Show
Cell 5
Cell 6
Ignore
I am using vba to convert the range to a html table, and then email it.
I have a helper column (Column C), and I want to use a formula there to filter out certain rows.
However, that filter is not excluding hidden cells from being displayed in the html table.
I currently use this
Dim LastRow As Long LastRow = rInput.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
to find the last row of my table. This works great in projects where you want all of the table included.
I tried to change it to Find("Ignore", which gets me Object variable or With block variable not set
I tried including 'SpecialCells(xlCellTypeVisible)' in my
ConvertRangeToHTMLTable(Sheet2.Range("$A:$J").Rows("5:" & LastRow), 5)
and using a filter to hide the 'Ignore' cells. But that did not stop them showing in the emailed html table.
You probably have some sort of loop which goes over the rows right? It will not automatically skip the hidden rows just because they are filtered out, you need to specifically tell it to skip them. You can do something like:
For Each r In myRange.Rows
If Not r.EntireRow.Hidden Then
doSomething
End If
Next r
Ended up adjusting the table (and thus the range I cared about) to start at row 1 rather than row 5, and using
strBody = dsaEmailHeader & ConvertRangeToHTMLTable(Sheet2.Range("$A:$H").Rows("1:" & LastRow).SpecialCells(xlCellTypeVisible))
worked, where it didn't previously.

Best way to run macro for over 500K rows?

I have a file with a bunch of rows that contains data for certain part numbers from different configurations. Some of these part numbers are repeated throughout the file, and in those duplicated part numbers may contain certain data and some may not. I am trying to find the best way to determine the commonalities in the file for certain data. So for the commonalities, if one row has a value and another row is blank, the value for the nonblank row would be put into the blank row. And if the data on those two rows were different it would change the font color on the cell indicating that this part number two different unique values and should be checked.
Dim i, j, n As Long
Dim lr As Long
Dim moaf As Workbook
Dim sht As Worksheet
Application.ScreenUpdating = False
Set moaf = Workbooks("MOAF3.xlsb")
Set sht = moaf.Worksheets("Wire Data")
n = InputBox("What column # are you trying to fill in?: ")
lr = Cells(Rows.count, 2).End(xlUp).Row
For i = 2 To lr
lkup = Cells(i, 2).Value 'sets first lookup value
Fill = Cells(i, n).Value 'sets the first data value to compare
If Len(Fill) > 0 Then
For j = 2 To lr
lkup2 = Cells(j, 2).Value 'sets the second lookup value
Fill2 = Cells(j, n).Value 'sets the second value to compare
If lkup2 = lkup Then 'checks to see if p/ns are same
If Len(Fill2) = 0 Then 'checks to see if second value is blank
Cells(j, n).Value = Fill 'if value is blank the cell takes value of non blank cell
ElseIf Fill <> Fill2 Then 'checks to see if the values are non matching and non zero
Cells(i, n).Font.ColorIndex = 3 'changes font color of two cells
Cells(j, n).Font.ColorIndex = 3 'changes font color of two cells
End If
End If
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub
Doing this generally freezes my excel, where my computer has 32GB of RAM and is Windows10. Is there a better approach for my problem, or is it something that can be done without using a vba? I've done some research on a method without using vba, but with like sumifs, countifs but haven't really done any deep dives.
So, if I understand your question correctly, you start with following data:
ID Column_header
2 a
3 _BLANK_
4 _BLANK_
5 b
6 _BLANK_
And you want to turn this into:
ID Column_header
2 a
3 a
4 a
5 b
6 b
I know a very simple trick for that (I have put everything in column 'A' for explanation):
Select every cell inside that column
Goto (Ctrl+G) Special, Blanks
In the formula bar, type =A2 (you are currently located in 'A3', and you want to copy there the value of the cell just above it)
Press Ctrl+ENTER
You'll see that 'A2' gets copied into 'A3', 'A3' into 'A4' and 'A5' into 'A6' (the fact that this is done for all blank cells, is due to the Ctrl+ENTER).
Record this into a macro, and it will go much faster.
I already see a question popping up : "Ok, but what about the font colour I want to change?". Well, the newly filled cells are based on a formula, so the length of =FORMULATEXT() won't be zero. You use this as a basis for conditional formatting.
Good luck
The inner for loop just needs to start at i, that is:
for j = i to lr
This should roughly half the runtime.
Further performance enhencements:
Use .Value2 instead of .Value property.
Or even better, read in the entire columns into an array, work on that in VBA, then write the result back.

Cut and paste using an offset

I am building a web scraping tool that obtains particular data. Once the data has been extracted the next step is to summarize it into a report thus i need some guidance on the final part of the project.
I have a column (Column A) that contains the following data set
Description of product
$3000
Description of product
$5000
etc
I would like to find a value (in this case the common value is $) and cut this value next to the description (into Column B). There could be hundreds of rows thus a loop would be required.
My initial thought is to use code that will find a value ($), then once the value is found, cut the row and using an offset paste the value (into column B)
Any help would be appreciated
sub test()
dim usedrows,i as integer
usedrows = activesheet.range("A" & activesheet.rows.count).end(xlup).row
for i=0 to usedrows
if instr(range("A" & i+1),"$") <> 0 then
'Checks if the looped cell has "$" sign
range("B" & i+1)=range("A" & i+1)
range("A" & i+1)=""
end if
next
end sub
Copy ColumnA into ColumB. Delete B1 with Shift cells up. Series fil1 a column with 1 in odd rows, 2 in even, then filter to select the 2s delete those rows and then the column of 1s.

how to hide sequence of rows where value is not equal to 1,31,61,91 etc

I want to hide all the rows other that rows having vales 1,31,61,91,121 etc
My row values are sorted and incrementing from 1 to 29160
Update code, as I miss interpreted your question (you want except). For very large data set the workbook might be slow to apply filtering due to re-calculations of worksheet. This VBA code hides all columns and then show every 30th row and is hopefully easy to modify for your purpose.
VBA Code:
Sub Hide_Every_nth_Row()
Dim n As Integer
Range("1:29160").EntireRow.Hidden = True 'Hide all rows from row 1 to 29160
For n = 1 To 29160 Step 30 'start from row 1 and loop to row 29160. After every loop it jump 30 rows.
Range(Cells(n, 1), Cells(n, 1)).EntireRow.Hidden = False 'Show the nth Row set as "Step". It check the nth row and Column A (A = 1), but since you show the whole row, the column doesn't matter :)
Next n
End Sub
n = 1: Which row to start from.
To 29160: Which your end row is.
Step 30: How many step to jump every time it loops, starts from the "n"th value.
EntireRow.Hidden = False: To show row. Set this as True to hide every row.

Excel VBA count cells until a date is found

I've got an amount of data copied from a table in a .pdf that when pasted into excel puts it all into one column. There are actually multiple pages each with it's own table (the data is one continuous long table split over multiple pages more accurately) and at the top of each page is a series of lines that I'm not interested in (the same unwanted data is at the top of each page). What I am interested in is re-sorting the data under the headers as it is in the table on the original .pdf document, removing the headers in the process. The data as it has been pasted into one column essentially is a list of items in plain text for x rows, followed by a list of start dates for x rows, and then a list of end dates for x rows, repeated every page.
I've figured out how to count the number of lines I don't want by getting a macro to look for the first piece of data I'm interested in ("AAAA") starting at cell (B2);
Cells(2, 2).Select
For i = 1 To 50
If ActiveCell = "AAAA" Then
Exit For
End If
ActiveCell.Offset(1, 0).Select
Next i
Cells(2, 3) = i
If i = 51 Then
Range("B3") = "Cannot find data"
End If
Which starts a search at cell (B2) looking downwards until it finds "AAAA" it then prints how many rows it has moved downwards to find it in cell (C2).
I now wish to be able to start at the cell it has just found [(B34) in this case] and count downwards until it finds the first cell containing a date.
Ultimately I'll need to then count down the same number of cells to find the associated end date and print them all in one row, continuing for the entire column of data.
If anybody could help me with being able to start at the first cell "AAAA" and then count downwards until a date is found, that would be really helpful.
My biggest challeng is to understand what you want to be true. I tryed to make a list of the things what you want.
You have a PDF that when paste in Excel it transform all the
document in one column.
There is a header in each of the Excel pages that you want to delete.
After you find a header you want to find two dates, and they have the same distance from the header.
How I would do it:
For iCounter = 1 to Cells(1048576, 1).End(xlUp).Row
If Cells(iCounter,1) = "YOUR HEADER HERE" then
For kCounter = iCounter to Cells(1048576, 1).End(xlUp).Row
If IsDate(Cells(kCounter,1)) = true then
initialDate = Cells(kCounter,1)
endDate = Cells(2*kCounter-iCounter,1)
End if
Next kCounter
End if
Next iCounter
The following piece of code starts in cell A1 and searches downward until it finds a cell containing a date value. The code only searches until it reaches the last record in the first column (to avoid searching all the way down to the bottom of the sheet if no date is found).
Sub FindFirstDate()
Dim i As Long
For i = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If IsDate(ActiveSheet.Cells(i, 1).Value) = True Then Exit For
Next i
MsgBox "The first cell with a date is " & ActiveSheet.Cells(i, 1).Address
End Sub
In this example the address of the cell with the first date in returned in a MsgBox.

Resources