I have a large macro which takes price book information from a vendors file, formats it and then creates a .txt file which then can be uploaded into the system. For this I prompt the user several times to select for example the column which contains information about the part number or the list price.
So far so good. When it comes to the following code, the macro just skips it:
'delete rows with no price
p = 0
For i = 3 To LastRow
If p > LastRow Then
GoTo Ziel4
ElseIf IsEmpty(wsImport.Cells(i, 8)) = True Then
Rows(i).Delete
i = i - 1
End If
p = p + 1
Next i
However, if I execute the code with a break point right before the loop and execute it, it works just fine. When I execute the whole script with another vendors file, it just skips 3/4 of the script and produces an empty .txt file. I already tried it with Application.ScreenUpdating = False to improve performance but it still keeps skipping lines.
not so sure about your code exact goal, but since you "prompt the user several times" and everything works when you "execute the code with a break point right before the loop", I suspect you're jumping between worksheets and hence you're prone to miss the proper worksheet
so change:
Rows(i).Delete
to:
wsImport.Rows(i).Delete
Make sure "LastRow" has a value prior to looping as stated by "DisplayName" above, and I would assume you want to start with the last row and then move up again when searching for empty rows, otherwise it would not make much sense, right? Question is, what is p used for? Why do you increase it by 1/iteration and abort the loop if it becomes > LastRow?
Try:
For i = LastRow To 3 Step -1 'Start at the end and move up, should save you the "p"
If IsEmpty(wsImport.Cells(i, 8)) = True Then
Rows(i).Delete
End If
Next i
Related
My task is to use Excel to manipulate a large set of data and I had heard of using a Macro but I'm not very code-savvy. I recorded the steps that are required using the macro function, but I need to add more lines of code to utilize looping and making sure it advances by 2 after every repeat.
I've posted my steps below:
Range("A5:C5").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A5").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+0.1"
Range("B7:C7").Select
Selection.Copy
Range("B5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Basically, select 3 cells (A5:C5) insert cells and shift cells down. Use a formula in the newly empty A5 to add 0.1 to A4 and copy values from B7:C7 and paste into B5:C5.
The following image shows a before and after of what I'm talking about to make things more clear.
Before
After
The next step would be:
Range("A7:C7").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A7").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+0.1"
Range("B9:C9").Select
Selection.Copy
Range("B7").Select
ActiveSheet.Paste
Application.CutCopyMode = False
and so on.
Any help with this would be greatly appreciated. I also apologize if what I'm asking is still confusing or not clear in any way.
[Prologue:]
Hi, I'll provide you with an answer and I tried to comment the heck out of it to make it as beginner friendly as possible, but the truth of the matter is:
I can explain to you how it's done, but you will never properly understand why it's done until you properly understand basic programming methodologies such as looping and that is something only you and you alone have to sit down to and fully comprehend
[The gaps in logic:]
Probably the biggest issue is, you have not specified what happens
when your data reaches empty cells (what I mean under that) - if in
your loop you were on row 10 (7, M, N) you would have no longer any
letters to add, as the next 2 rows (12) no longer contain eny data.
Given this, I modified the loop to start at the n-2th row instead to prevent this from happening (that means in your example it will end (or start to be more precise) at 6.1 as it's the last row that can retrieve the data)
In general, I'd recommend posting not only a picture of input data, but rather than picture of current result in this case a properly explained expected result would be much more to our benefit and understanding and would have saved me a lot of the guesswork here.
[The theoretical part of your question:]
I'll save you a bit of googling time here with few useful facts.
If you're looking to repeat a specific action, you should always be looking to utilize one of the 2 (or 3 depending on how you classify them) loops for and do (while/until)
Better yet, if you're looking to loop a variant amount of actions for repeated amount of times, you should utlize either a procedure Sub or a function Function so you can use arguments that act as a variable for the loop.
Generally when adding or removing rows it's important to loop from Bottom to Top (from Last to First). Why? Because if you add an extra row, it's going to mess up your Row order.
With all that in mind, the procedure itself could look something like this:
[The solution itself:]
You can use the following procedure every time for a specified range.
Option Explicit 'prevents typo. errors, undeclared variables and so on
Private Sub extra_row(ByVal rng As Range) 'declaration of procedure
Dim i As Long
' we loop for the n-th - 2 row (last row - 2) to the pre-first (added) row.
For i = (rng.Rows.Count + rng.Row - 2) To rng.Row + 1 Step -1
'why the -2? ^ Because if you add the letters from next 2 rows,_
the last 2 would have no to grab _
eg. Row 10 and 11 in your original data would have no data under them to grab
' a bit harder section to comprehend, if it's the first data entry _
we need to account for the fact that we have not added any extra rows yet_
hence we also need to decrement the row from which we receive the data by 1 _
it 's bit of difficult to word, i'd highly recommend debugging yourself _
and seeing what happens with or without it
Dim fp As Integer
If (i - 2 = rng.Rows.Count) Then
fp = 1
Else
fp = 0
End If
' now we just add the extra rows where we can
Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 1) = Cells(i, 1).Offset(-1, 0) + 0.1 'we add 0.1 to cell one above
Cells(i, 2) = Cells(i + 3 - fp, 2) ' similar case, with letters, but two below
Cells(i, 3) = Cells(i + 3 - fp, 3) ' similar case, with letters, but two below
Next i 'and we loop for every cell in our specified range
End Sub
Eg. in your case, you could run the procedure with the following command:
Call extra_row(Range("A4:A11"))
[Practical use]
While the solution itself should work, in a real world example it probably might be smarter not to use a specific range to call for each procedure. Especially if that means use has to look at the worksheet, check the range and count the rows manually.
That's one of the reasons we created a procedure here to begin with. So I created one more procedure akin to main() in most programming languages which detects the last active row and applies the procedure to your data range by detecting it automatically.
So in the end, your could should look something like this:
Option Explicit
Private Sub extra_row(ByVal rng as Range)
'... code from the answer here
End Sub
Private Sub rundata()
Dim lr As Long
lr = Sheets("Your Sheet Name").Cells(Rows.Count, 1).End(xlUp).Row
'detects the last active (nonempty) row _
rememeber to change the Sheets("") to wherever your data is stored
Dim mydata As Range
Set mydata = Range("A4:A" & lr) 'under presumption your data always begins with A4
Call extra_row(mydata)
End Sub
Now, whenever you would run (manally) or Call the run_data() procedure it would automatically detect the range and apply the procedure we defined to it.
[Expected result visualization and closing words:]
We started with this:
After running the procedure:
Now I know, it may seem like there's a lot of novel concepts here, but truth of the matter is, all of them are fairly easy once you buckle down and try to comprehend the code line by line. Most of it is simple mathematical operations.
If you still have trouble comprehending anything here, do your own research first and then post comment here or better yet, create a new question (if it warrants it).
Good luck on your coding journey! :)
Rawrplus
This code should do the trick.
The code gives you an InputBox in which you can type in the number of times to run the code.
Sub test()
Application.ScreenUpdating = False
Dim Grab As Range
Dim RunTimes As Long
On Error GoTo Get_Out
RunTimes = InputBox("How many times shall the code run?", "Run times")
On Error GoTo 0
For x = 1 To RunTimes * 1.5 + 3 Step 2
Set Grab = ActiveSheet.Range("A" & x + 4)
Grab.EntireRow.Insert
Grab.Offset(-1, 0).Value = Grab.Offset(-2, 0).Value + 0.1
Grab.Offset(-1, 1).Value = Grab.Offset(1, 1).Value
Grab.Offset(-1, 2).Value = Grab.Offset(1, 2).Value
Next x
MsgBox "Succes"
Get_Out:
Application.ScreenUpdating = True
End Sub
Let me know if you have any questions about the code or if you want me to explain it further :)
I am pulling my hair out over this as I cannot see why this isn't working. Any help or guidance would be greatly appreciated.
I have inherited a macro in Excel which runs differently depending on which PC we run it on. Essentially, the macro inserts blank rows into a table of data (which should also have conditional formatting to make it blue to break up the table and make it easier to read). On my PC instead of a blank row being entered, it is a row of #ref errors and loses the formatting.
We have a different macro assigned to a button which runs three macros one after another. The one I have the issue with is the third of these three. When I run the macros as three separate events it works, but together it has the #ref errors.
Sorry for the small snippet of the file, but it is sensitive information.
I have tried adding a pause in between the second and third, but this doesn't help.
Are there some security settings which I should check?
The macro looks at a formula in column A and looks for the number 5 and inserts a row after this line. The code is as follows:-
Sub Main()
Dim r As Range
Dim i As Long
i = 1
Do While Range("A" & i).Value <> ""
If Left(Range("a" & i), 2) = "5" Then
i = i + 1
Rows(i).Insert
Range("A" & i).Value = Range("a" & i - 1).Value
End If
i = i + 1
Loop
End Sub
What I am struggling to get my head around is that it works in isolation, but not when run with other macros. For completeness the macro which runs the three has the following code:-
Sub runall_CVR()
Application.ScreenUpdating = False
Call hiderows_CVR
Call Delete0s_cvr
Call Main
Application.ScreenUpdating = True
End Sub
Many thanks
James
The following is the result of downloading information from an accounting system. Basically, I was tasked with sorting through expenses from this year from an online system; once the information was downloaded from the online system, it was not formatted as a spreadsheet (so I couldn't easily use a simple lookup). The information was downloaded as a spreadsheet, however it didn't contain check numbers or names; excel formatted those away for some reason. The only thing that was left is the long stringy document, where each item in the PDF downloaded (which contained check numbers and names) was placed in column 1 (see picture 1), whereas it should have been placed in something formatted like picture 2. Obviously though PDF's do not maintain formatting.
So baring some way that I can transfer the PDF to a workbook and run an analysis (IE through copy paste or save as) I needed to get information from this long stringy thing (it's at 9000 rows at the moment, added in an excerpt).
First, this code sets the worksheet pers as a worksheet, gets the length of data in pers (example in picture 2), and length of data in expensesheet (example in picture 1)
Then it scans pers for items (prior to writing this code items were added manually - such as in the case of picture 2, 'supply 1' and corresponding information that can help denote supply 1, ie invoice #, description, date cut, and so on).
For each of those items, it then scans the "expense sheet". It tries to match the invoice number (which is the closest thing to a unique ID in this case) to the value in cell i, 1; if it exists, it then scans 'upwards' until it finds a long enough string so that it can be the 5 unit string; the one that contains a date, a check number, an amount, and a name, as well as a batch number and a memo.
Once it finds that string, it then splits it into an array, and then seeks to place it in the corresponding cells to the right of that row in worksheet pers.
Issues:
1) I keep receiving an error 400. Normally when I receive an error VBA shows what line. What is this? How can I set up an error catching block so that the editor will provide me more details on the error (ie place it occurred, reason for occurrence, etc)
2) I'm assuming that the long row (in this case its 12th from the top) can only be identified through its length. Is there a better way to identify the long row? Perhaps if it contains multiple dashes?
3) Does anyone know of a way to easily transfer a PDF of an accounting printout so that it retains its formatting when saved or copied to a spreadsheet?
4) Is there a way that this spreadsheet could be easily formatted through excel so that it can more adequately fit into the proper mold (more like picture 2)?
Option Explicit
Sub findDetailMemo()
Dim pers As Worksheet
Set pers = ThisWorkbook.Sheets("PERS")
Dim persLength As Long
persLength = pers.Range("a1").End(xlDown).Row
Dim expenseLength As Long
expenseLength = Range("a1").End(xlDown).Row
Dim currentDetail() As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim tempInt As Long
'first scan all of the items in the pers unit
For k = 2 To 10
'next scan all of the expenses
For i = 2 To expenseLength
'if the invoice # is found
If InStr(Cells(i, 1), pers.Range("a1").Offset(k, 3)) <> 0 Then
'scan upwards; make sure you don't scan beyond the range of the spreadsheet
For j = i To 1 Step -1
'if the scan upwards finds a string that is 80 characters or more
If Len(Cells(i - j, 1)) >= 80 Then
'split it at the -
currentDetail = Split(Cells(i - j, 1), "-", -1, vbTextCompare)
'add it to the pers sheet
pers.Range("a1").Offset(k, 11) = currentDetail(0)
pers.Range("a1").Offset(k, 12) = currentDetail(1)
pers.Range("a1").Offset(k, 13) = currentDetail(2)
pers.Range("a1").Offset(k, 14) = currentDetail(3)
Exit For
End If
Next j
Exit For
Else
End If
Next i
Next k
End Sub
EDIT: After a discussion through the chat lobby, bdpolinsky and I found what was throwing the original error 400 (which was actually error 1004).
The first issue we fixed was the InStr() and Split() functions were referencing Cell objects instead of the string within them. This was fixed by simply adding Cells().Text where strings were required.
On the line If Len(Cells(i - j, 1).Text) >= 80, we discovered that Cells() wasn't referencing the correct worksheet. The fix for this was to define Cells() as pers.Cells(), which is the worksheet the information was imported to. Happy to report that the problem bdpolinsky was having has been solved (as far as the errors go).
The following is from the original answer:
1) At the start of your code (first executable line) you can press F8 to step through the code 1 line at a time until the error is flagged.
You can also use error handlers to catch an error and have excel do something different than default. Error Handling
Sub SomeCode()
Dim i As Integer
On Error GoTo ErrHandler
i = 1/0
ErrHandler:
MsgBox "Error Description: " & Err.Description
End Sub
You can also click next to a line of code to add a Break. Breaks look like red circles, and color that line of code red. Your code will stop when it reaches this line.
2)If Len(cellThatYoureChecking) > 20 Then Code
Or
If InStr(cellThatYoureChecking, "symbolYouWantToFind") <> 0 Then Code
Or visit this post about defining how many times a character is in a string with a function. You could then make your If statement based on the number of times it occurs.
3) This part is poor form for StackOverflow, but what you're asking is a little involved so see if this tutorial is of use to you. Import table from PDF to Excel.
4) The short answer to this is yes. There are a lot of ways to reorganize data in Excel. This question is a little too broad though, and it'd be more efficient to get questions 1-3 answered first before getting too ahead of ourselves.
I couldn't find the answer to this issue anywhere, so I do hope you guys can help me. My excel macro goes through a couple iterations of data. It autofilters a source file, takes out information, works with the data, and does so again for about 50 times - once per person. Here's some code of what I mean, all the individual submethods work just fine and are pretty damn fast:
For j = 1 To names.Count
'filter the source by name, generate sheet
FilterName names(j)
'prepare data with the necessary dates
FillMasterDates dates(), j
Dim i As Long
Dim ending As Long
ending = Sheets("Daten").Rows.End(xlDown).Row
Dim cellvalue As String
'check dates, etc
For i = 1 To ending
cellvalue = Sheets("Daten").Cells(i, 1)
If cellvalue = "" Then
Exit For
End If
ColorCell (i)
FilterDate CStr(dates(i)), names(j)
Next i
'user data has been successfully gathered, copy over to final sheet
FillColumns j
Next j
The whole code takes about 4~ seconds to run (given that I have about 2000 rows and I create a new sheet for 50~ people), which is fine. The baffling thing is that when Excel stays my active window despite using Application.ScreenUpdating = False (earlier in the macro, but still active at this point), the necessary time to run the macro goes up to a staggering 25~ seconds. Same input, same output. So to put it simply - run macro, tab out of excel - macro needs about 4-5 seconds to run. run macro but stay in excel and wait - 25 seconds.
I've tried Application.WindowState = Application.WindowState, ActiveWindow.SmallScroll, DoEvents, Application.CalculateFull(). I tried different calculation settings, but I do not really use any of the formula calculations innate to Excel - I have to use Excel as an interface because the source file is an *.xls file and the final output has to remain in this format.
If you need me to provide more code snippets to make sense of it, ask away. I've been stumped for a good two days now.
You could always try a couple more lines to disable the calculations and alerts etc.
Application.ScreenUpdating = false
Application.Calculations = xlManual
Application.DisplayAlerts = False
However if you really want to bypass all the background nonsense excel seems to go through dont access the sheet directly through a loop, this concept maybe tricky if your not used to it but its worth every bit, and will speed up your code so fast you will wonder why you never did it in the first place.
I dont have your code so ill just give an example of how it works
Dim RangeArray as Variant 'This will store your range as a values array
RangeArray = Sheet1.Range("A1:G100000").Value 'this will put the entire ranges values into the array
If Not IsArray(RangeArray) Then ExitSub 'If your range is only 1 cell it will not create an array so be careful, handle this as needed
'This Array always starts lowerbound 1, RangeArray(1,1) = First Cell
Now with this you can loop through your data and manipulate and modify the array just like you would with a cell or a range except there is no overhead, its just values and not objects .
Once you have done what you need all you need to do then is put the values back into the sheets range
Sheet1.Range("A1:G100000").value = RangeArray
And thats it, very simple and very effective, and this transfer from array to range is immediate no matter how big it is.
Just let me know if this helps
Thanks
Paul S
---------------NEW MESSAGE-------------------
You could try something which maybe a little excessive and risky, if your only getting this problem while the window is active and displayed how about making it invisible, the problem is if your code fails and you fail to trap an error it will remain invisible until you goto taskmanager and close it there.
Application.Visible = false
This should deactivate the window too (although i have never tested that)
this should simulate you hiding the window and just bring it back when your code has finished..
---------------NEW MESSAGE-------------------
Application.Windowstate = xlMinimized
This should do the trick :D, should have mentioned this first haha
I also just saw that you tried something similar, but the code is incorrect there, try this one
Basically, i'm trying to mimic a concatenate result using code i stripped apart and recycled for my purposes. But i'm having problems when the script attempts to process "Next T" idk, but i already indicated as a Dim - Integer, and that still didnt seem to do the trick.
Original source of code:
Concatenate multiple ranges using vba
I've been having a lot of problems with this one piece, cause it seems to be the only thing i've actually been trying to include in my script for a long time now. Had compile errors with closing the If, adjusting the Then, and even Exiting the loop.
I think the Next should be my final worries.
Btw, rnumbers is supposed to hold the place of a value/integer, but i'm not entirely sure if that was done correctly either.
rnumbers = Rows(ActiveCell.Range("A3").End(xlDown)) + 3
'or CellCount = ActiveCell.Range("A" & Rows.Count).End(xldown).Row
Do While Rows(ActiveCell.Range("A3").End(xlDown)) > 3
'For Q = 1 To 10 'This provides a column reference to concatenate - Outer For statement
For T = 3 To rnumbers 'This provides a rows reference to concatenate - Inner for statement
For Each Cell In Cells("A" & T) 'provides rows and column reference
If Cell.Value = "" Then
GoTo Line1 'this tells the macro to continue until a blank cell is reached
Exit For
End If
x = x & Cell.Value & Chr(10) 'This provides the concatenated cell value and comma separator
'Next ' this loops the range
Next T 'This is the inner loop which dynamically changes the number of rows to loop until a blank cell is reached
Line1:
On Error GoTo Terminate 'Terminates if there are less columns (max 10) to concatenate
ActiveCell.Value = Mid(x, 1, Len(x) - 1) 'This basically removes the last comma from the last concatenated cell e.g. you might get for a range 2,3,4, << this formula removes the last comma to
'give 2,3,4
ActiveCell.Offset(1, 0).Select 'Once the concatenated result is pasted into the cell this moves down to the next cell, e.g. from F1 to F2
x = "" 'The all important, clears x value after finishing concatenation for a range before moving on to another column and range
'Next Q 'After one range is done the second column loop kicks in to tell the macro to move to the next column and begin concatenation range again
'rnumbers = 0
'Next
Exit Do
'Resume
Terminate:'error handler
Trying again... when I took a closer look at your code I actually used a Bad Word.
You have been hanging with the wrong crowd, and are picking up some really bad code structure ideas. A GoTo followed by an Exit For? The latter statement can never be reached! And jumping out of a For loop is a dangerous (if not wrong) thing to do. And yes, you still needed a Next for the For Each statement (with a matching control argument - the Next T belonged with a different For loop, not the innermost one).
Anyway - I felt like the Cat In The Hat: "This mess is so big and so deep and so tall - we cannot pick it up, there is No Way At All!". So I decided to build you a new house instead.
I think the following does what you want to do, and quite elegantly. See if it makes sense, and if you can adapt it for your purpose. I need to go to sleep but will take a look in the morning to see if you figured it out from here.
Sub concAll()
Dim allRows As Range, target as range
Dim oneRow
Dim nc as Integer
Set allRows = Range("A3", "J10") ' pick the real range here - dynamically, probably
nc = allRows.Columns.Count ' need this number later to know where to put result
For Each oneRow In allRows.Rows ' loop over one row of the range at a time
Dim s As String
s = "" ' start with empty string
For Each c In oneRow.Cells ' loop over all the cells in the row
If Not IsEmpty(c) Then
s = s & "," & c.Text
Else
Exit For ' done with this row: found empty cell
End If
Next c ' keep looping over the cells...
Set target = oneRow.Cells(1).Offset(0, oneRow.Cells.Count) ' cell where we put result
target.Value = Mid(s, 2) ' put the concatenated value to the right of everything;
' skipping first comma (which came before first text)
Next oneRow ' repeat for all rows in source range
End Sub
I'm sorry, i shouldve explained what i was trying to produce than asking to fix something i wanted to do. My experience in vba has been self-taught, and i'm a little new to asking for help.
The script Floris produced seemed to have function but not as intended. Turns out what i wrote is a little outdated, and needs to be wiped and restarted. This was actually an old script i started a few months back that worked off of a web-query. But the website went thru some changes and now the script is all over the place.
the main issue i was having was a compile-error "Invalid Next Control Variable Reference" Which turns out to be caused by an open 'Do while' loop, that doesnt seem to have much of an exit point from the research i looked up. Was supposed to have used another 'If' command instead. At the same time, when attempting to solve that 'Do While' i added an extra 'Next' (cause i thought they were compatible), and it screwed with the script.
Hard to explain.. But the 'Do While' i used, i wanted it to combine the values only if the number of values were greater
rnumbers = Rows(ActiveCell.Range("A3").End(xlDown)) + 3
'or CellCount = ActiveCell.Range("A" & Rows.Count).End(xldown).Row
Do While Rows(ActiveCell.Range("A3").End(xlDown)) > 3
But instead it was supposed to be
Dim CellCount As Range
CellCount = ActiveCell.Range("A" & Rows.Count).End(xlDown).Row + 2
'cause its the active cell + two additional cells
If CellCount > 3
Which then opens up into the script Floris submitted. (But that failed too, because of what was stated above).
Thanks again, hope that it explains everything... Sorry if i wasted your time with that one Floris, really do appreciate the assistance. Just wish i had asked for the help sooner, would have saved me a lot of frustration that i'm dealing with now. >_>