Run VBA format code on all sheets with different number of rows - vba

VBA noob here needs a little bit of assistance. I cannot seem to find a solution or get something to work.
I've tried to simplify it as much as I could to get a proof of concept.
The basic idea is to format one cell (A1 say) with all borders, copy that format down across all data in the first sheet (A1:C10 for example), then do the same with data in subsequent sheets. What I'm struggling with is that subsequent sheets all have a different number of rows and anything I try just formats the additional sheets to the (A1:C10) of the original even if there is no data present.
Any help would be greatly appreciated.

What you need is a variable that identifies the last row of any given sheet. For instance
LastRow = Worksheets("Sheet1").cells(65000,1).end(xlup).row
Now you can loop through your cells
for i = 1 to LastRow
for j = 1 to 3
Worksheets("Sheet1").cells(i, j) (apply your formatting)
next j
next i

You can find the last row in a column by using this VBA code:
lastrow = Sheets("SheetName").Cells(rows.count,columnnumber).end(xlup).row
Change columnnumber to the number of the column you are looking in, for example column A = 1.

Related

Copy Range Excluding Blank Cells - Paste to Another Sheet

Ok, back again!
I have tried to search throught this and other forums to find a similar solution, but everything Ive found is either just different enough that I cant figure out the application to my problem, or super complex, and I cant translate it! So Im hoping someone can help me here. Thanks in advance!!
Here is the scenario. I have a database that Im needing to add data to. Quote Number, PO Number,SubSystem Part Name, Vendor, Material, Price, Qty. Etc.
Long story short, and without getting into the context of why I did it this way (mostly because I think I would botch the explaination and be more confusing than helpful!) ... I have essentially 3 tables right next to each other.
Table 1 is columns H and I. These all have a formula similar to =if(isblank(J4),"",$I$1) Where I1 is the PO Number (which will remain the same for this set of entries.)
Table 2 is a pivot table in columns J through M. Using a slicer the user can select what sub systems they need for this PO. The pivot table will repopulate with the appropriate part numbers and unique information contained in another table.
Table 3 is a regular table in columns N through R. These columns have some formulas like above that pull from a single cell (for entering the date), some pull information from another table based on information in column J via a VLOOKUP, and some information is entered manually.
That might be too much information, but better to have it and not need it eh?
So heres the goal. With a VBA macro, I want to copy the data and paste it onto another sheet, at the bottom of a database. The trick is, because that whole setup above runs based on information coming from a pivot table, the list changes length constantly. It will never be longer than a certain length (still TBD) but will almost always be shorter. I can copy the whole thing, and have it paste to another sheet below the last entry... but it pastes below the last empty cell in the database sheet. What I mean is this:
The longest the table could be would be range H4:R38 for example. So I copy that, paste it to Sheet2 starting at cell A2. Upon further inspection, we see that there is only actual data in the range H4:R11. However, when we pasted it to Sheet2 it pasted the whole range H4:R38. When I run the macro again, instead of the new data set being pasted to row A10 (the row after where the data should have ended), it pastes to something like row 36... because its pasting below all the blank cells.
I have no idea what to do or where to start. Any help would be greatly appreciated! Thanks so much!
Code I've Tried:
Dim fabricationrange As Range
Dim destination As Range
Dim LastBBUFabDatabaseRow As Long
Worksheets("Sub Systems").Range("h4:r38").Copy
With ThisWorkbook.Sheets("BBU Fab. Database")
Worksheets("bbu fab. database").Range("z" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Range("b" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
lastbbufabdatabserow = .Cells(.Rows.Count, 2).End(xlUp).Row = 1
Set destination = .Cells(LastBBUFabDatabaseRow, 2)
destination.Value = PasteSpecial.Values
End With
Untested but here's a brute-force approach to locating the first empty row:
set rngDest = ThisWorkbook.Sheets("BBU Fab. Database").rows(2) '<< start here
do while application.counta(rngDest) > 0
set rngDest = rngDest.offset(1, 0) 'next row
loop
Worksheets("Sub Systems").Range("H4:R38").Copy
rngDest.cells(1).PasteSpecial xlPasteValuesAndNumberFormats '<< paste to col A

Excel macro - how to break wrapped text into rows for merged columns?

I have to import data from PDF to SAS, and one step involves converting the PDF data to excel spreadsheet before converting to text for simpler SAS import. Usually the PDF data converts fine into excel, with few errors. As I am trying to import older data, it is getting quite messy and some of the rows get wrapped in a single cell. I am trying to figure out if there is a macro possible which can help me fix this error in sheets without too much manual manipulation. I have never programmed in VBA before so I am quite new to excel macros.
Here is the example of messy data:
Here is the example of normal data:
(*Note the data values in the two images are different, just for example formatting)
I have tried working on a macro. For this, I copy the messy data into another sheet, and run the macro which outputs corrected data on a separate sheet, and then i copy the corrected data over the messy one in the original spreadsheet.
After trying to code the macro, I was unable to figure out how to tell excel to take the data in columns C,D,E,F which are all merged into one cell and break that wrapped text, and so on for other merged columns (as shown in messy data image).
Here is my current code that I got after watching some tutorials:
Sub Split_Text_to_Rows()
Dim splitVals1 As Variant
Dim splitVals2 As Variant
Dim totalVals As Long
Set sh1 = ThisWorkbook.Sheets(2)
Set sh2 = ThisWorkbook.Sheets(3)
sh2.Cells.Clear
lrow1 = sh1.Range("A65356").End(xlUp).Row
For j = 1 To lrow1
splitVals1 = Split(sh1.Cells(j, 1), Chr(10))
splitVals2 = Split(sh1.Cells(j, 2), Chr(10))
For i = LBound(splitVals1) To UBound(splitVals1)
lrow2 = sh2.Range("A65356").End(xlUp).Row
sh2.Cells(lrow2 + 1, 1) = splitVals1(i)
Next i
For k = LBound(splitVals2) To UBound(splitVals2)
lrow3 = sh2.Range("B65356").End(xlUp).Row
sh2.Cells(lrow3 + 1, 2) = splitVals2(k)
Next k
Next j
End Sub
As you can see, my code is also quite messy. Although, I got the code to work for columns A and B, when I get to column C - "Motor Vehicle Theft" and so on, I am not sure how to separate that wrapped text since they are merged in columns C,D,E,F. I would also like to keep the columns I to Q as two merged rows even after macro splits 1 row into 2 (shown in normal data image) and then continue splitting cells till column Z.
Any tips would be helpful! Please let me know if more information or clarification is needed.
I often find that the best approach is to first paste the data into Word, do some clean-up there, format it as a Word table, and then transfer it into Excel. The reason is that Word has very powerful find/replace features which allow you to quickly convert a mess into something sensible. Since you didn't provide example data I could paste in, I randomly found a pdf on the web to show one approach. The key in this case was noticing that each column begins with a space followed by a digit. So I did a search for " ^#" (a space followed by 'any digit') and replaced it by "^t" (tab character). Next, I used Word's 'Convert to Table' feature, and after that the data table is ready for pasting into Excel.

sumifs to loop all sheets

I have been searching different forums and cant seem to find my answer.
I have rather basic VBA knowledge and build most of my code from bits online!
Regardless of cell references as I would be able to work these out at a later date.
Please can you let me how I would make a sumifs formula reference across multiple sheets.
This is being build into a template and there would be a different number of sheets with different names each time it is run so I would be not be able to reference the sheets.
sorry thats a bit vague
thanks in advanced
Thanks, so for anyone else who needs this, this is how it was done in full
my original formula was
"=SUMPRODUCT(SUMIF(INDIRECT(" '"&Invoices&"'!"&"A2006:A3005"),A3,INDIRECT("'"&Invoices&"'!"&"B2006:B3005")))"
this worked when putting straight into a cell but as you can see, when adding it to VBA it reads it as a comment. To fix this, every time you use a " you need to add extra " as shown bellow (apart form before the" = at the start and after the )" at the end of the formula)
*****'list all the sheet names in cell AI1 of the sheet summary*****
For i = 1 To Sheets.Count
Sheets("Summary").Range("AI1")(i, 1).Value = Sheets(i).Name
Next i
***'clear the first 3 entries in AI as i didnt need the first three sheet names***
Sheets("Summary").Select
Sheets("Summary").Range("AI1:AI3").Clear
***'select the first sheet name, which is in AI4 as we cleard the first 3 to the last used cell, e.g Ctrl.Shift.down***
Sheets("Summary").Activate
Sheets("summary").Range(ActiveSheet.Range("AI4"), ActiveSheet.Range("AI4").End(xlDown)).Select
***' Name the range invoices***
Selection.Name = "Invoices"
' ***Formula to do a sumIf looping all the shets in the named range Invoices***
Sheets("summary").Range("B3").Formula = "=SUMPRODUCT(SUMIF(INDIRECT(""'""&Invoices&""'!$A$2006:$A$3005""),$A3,INDIRECT(""'""&Invoices&""'!B$2006:B$3005"")))"

Move row entries to a third file based on comparison among Files or workbooks one and two

I think that my question was not clear earlier. So, I am attaching sample data along with a detailed insight into the requirement. Please advice.
https://docs.google.com/spreadsheets/d/1GUuNFkJdgpStfLH1oBTAvxEgW9V1v13Z5aJ9goA8C0M/edit?usp=sharing
https://docs.google.com/spreadsheets/d/1B9LObbHmu0G9pBHbFqbcR4fNJuSr8BvpqJHfVi9J2fg/edit?usp=sharing
Requirement:
a)Compare the data in Files named John.xlsx with Jack.xlsx
b)Specifically compare the Columns B and C .
c)If both Columns match, then move the entire ROW from Jack.xlsx to a third file Lilian.xlsx which will be having the same columns headers and is just a blank file at the moment.
d)Delete the moved row from Jack.xlsx
e)Save Jack.xlsx and Lilian .xlsx
Does that make any sense?
Thanks for the effort :)
PS: ( sorry, but I am not able to attach more than 2 links in the post coz of my reputation point in the forum is quite low. New to the forum -.-' ). Otherwise, I will put a link for the Lilian.xlsx file as well.
You might consider using native Excel features, rather than trying to code something in visual basic. For example, try =MATCH() formula combined with the autofilter feature, and set the criteria to hide anything that does not match, i.e. comes up "#N/A".
Once you get the data to display as you expect, then copy and paste to new tab, and save-as new.csv.
Assuming you have 3 sheets. Sheet1, Sheet2 and Sheet3, the code below checks columns C for sheet1 and sheet2 for the first 10 rows. If it finds a match it will copy the data to the first column in sheet3:
Sub main()
Dim i As Integer
Dim intCurrentRow As Integer
intCurrentRow = 1
For i = 1 To 10
If Sheet1.Cells(i, 3) = Sheet2.Cells(i, 3) Then
Sheet3.Cells(intCurrentRow, 1) = Sheet1.Cells(i, 3)
intCurrentRow = intCurrentRow + 1
End If
Next i
End Sub
Data in sheet 1:
Data in sheet2:
Result, Data in sheet 3:

Selecting all data from a default table size VBA Excel

I have a spread sheet with a default table size and layout that is populated by information from another spread sheet. This table will always have the same number of columns, but the number of entries in the rows can vary. I want to select all the data from the table, and paste it into another sheet, without copying any empty rows.
My initial attempt involved the following code:
Set rightcell = Range("B9").End(x1Right)
Set bottomcell = Range(rightcell).End(x1Down)
To define what the bottom right corner should be, so I can reference the entire table like so:
Range("B9", bottomcell).Select
Or copy or whatever. When I run this, it gives me a "user-defined or object-defined error" and I don't know why. I have the code entered as part of a larger sub, and I have defined my variables as both ranges and variants to try and get this to work. I have spent quite a bit of time scouring the internet for a solution, but so far the information I've found has not explicitly related to my problem, and none of the similar solutions work.
Does anyone know what the appropriate coding for this is, or if I am making some minor error that is throwing everything else off? I remember encountering the same issue during a project in college, but for the life of me, I can't recall the solution. It's quite frustrating.
Also, if I am too vague or you need more clarification on the task, don't hesitate to ask. Thanks in advance for the help!
EDIT: An important note that I left out is that the the table I want to extract data from is in the middle of a page with multiple other tables that I am not trying to interact with.
If the table will always be in the same location on the sheet, you can do something like this to copy the entire table:
'Modify this to any cell in your table (like the top left hand cell):
Range("B9").CurrentRegion.Copy Sheets("TheSheetYouWantToPasteTo").Range("A1")
Even if the table's location on the sheet changes, you can still use the above code to copy the table as long as you know one of the cells in the table.
If you want to keep the same method as you're trying, try this instead:
Dim rightcell As Long
Dim bottomcell As Long
'Finds the furthest column to the right:
rightcell = Cells(5, Columns.Count).End(xlToLeft).Column
'Finds the bottom most row in the table (will stop at the first non-blank cell it finds.)
bottomcell = Range("B:B").Find("*", Range("B9"), searchdirection:=xlPrevious).Row
'Reference the variables like this:
Range(Cells(9, 2), Cells(bottomcell, rightcell)).copy _
Sheets("TheSheetYouWantToPasteTo").Range("A1")
this is what I use
Public Function last_row() As Long
Dim i As Integer
Dim l_row As Long
'my sheet has 35 columns change this number to fit your
For i = 1 To 35
If Sheet1.Cells(Rows.Count, i).End(xlUp).Row > l_row Then
l_row = Sheet1.Cells(Rows.Count, i).End(xlUp).Row
End If
Next i
last_row = l_row
End Function
Then Use
Dim l_row As Long
l_row = last_row
'Again since you know the last column change 35 here to your value
'or use the String i.e. "AI"
Range("B9", Cells(l_row,35)).Select
This will look at every column to determine the the last row that contains data