loop copy paste randomly leaving out data - vba

has anyone had an issue in excel vba where a loop to copy and paste rows and check for certain criteria sometimes leaves out information and after i try to debug and run through it works fine
I have a loop
For rnum = 3 To LastRow
'if all cells are equal to the Comboboxes then copy and paste the row
ThisWorkbook.Activate
If Sheets("Revised Budget").Cells(rnum, 1).Value = BUval And _
Sheets("Revised Budget").Cells(rnum, 2).Value = TeamLocVal And _
Sheets("Revised Budget").Cells(rnum, 3).Value = YrVal And _
Sheets("Revised Budget").Cells(rnum, 9).Value = InstVal Then
Sheets("Revised Budget").Range(Cells(rnum, 1), Cells(rnum, 12)).Copy
NewWkbk.Sheets("Actual").Activate
If NewWkbk.Sheets("Actual").Range("A1").Offset(1, 0).Value = "" Then
NewWkbk.Sheets("Actual").Range("A1").Offset(1, 0).PasteSpecial
Else
NewWkbk.Sheets("Actual").Range("A1").End(xlDown).Offset(1, 0).PasteSpecial
End If
Application.CutCopyMode = False
End If
Next rnum

Are your variables strings or integers?
If any of them are strings you can try making sure it's not an issue with capitalization on your string matches.
ucase(Sheets("Revised Budget").Cells(rnum, 3).Value) = ucase(YrVal)

Consider updating all of your .value to .value2. I was running into a (potentially) similar issue, and that fixed it for me.

I think I may have figured it out through some more research. The page in which the macro was running through had data that was filtered. I put in a code that would ShowAllData and I believe that should fix the issue.

Related

Paste the same blck of data below its self twice (or more)

I'm working on a formatting project for a monthly template. The data in column "E" will be static in each work book but different in other workbooks I'll run the macro on. IE one workbook may have 10K rows in column "E" and another workbook could have 20K in column "E". I need to copy that block of text below its self 2x. So I have a triplication of all that data from "E2:E".
I'm not looking for HUGE solutions with a million unnecessary Dimed variables. I'm close. What am I missing?
Range(Range("E2"), Range("E2").End(xlDown)).Select
Selection.Copy
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Paste<------ ERROR!
Becoming frustrated.
Using < 1million variables...
With ActiveSheet
With .Range(.Range("E2"), .Cells(.Rows.Count, "E").End(xlUp))
.Copy .Offset(.Rows.Count, 0)
.Copy .Offset(.Rows.Count * 2, 0)
End With
End With
Compared to #Tim-Williams answer, this feels positively hideous. However, I present to you:
Range(Range("E2"), Range("E2").End(xlDown)).Copy
For idx = 1 To 2
Cells(Range("E2").End(xlDown).Row + 1, "E").Select
ActiveSheet.Paste
Next
the following is almost there:
Application.CutCopyMode = False
Range(Range("E2"), Range("E2").End(xlDown)).Select
Selection.Copy
I just need it to drop down 1 and paste that, THEN drop to the NEXT blank row and paste it again.
my 0.02 cents
Range.Value approach (pasting values only)
With Range("E2", Cells(Rows.Count, "E").End(xlUp))
.Offset(.Rows.Count).Value = .Value
.Offset(.Rows.Count * 2).Value = .Value
End With
formula approach (and pasting values only)
With Range("E2", Cells(Rows.Count, "E").End(xlUp))
.Offset(.Rows.Count).Resize(.Rows.count * 2).FormulaR1C1 = "=R[" & -.Rows.Count & "]C" '<--| have 2x referenced range cells below it with its values
.Resize(.Rows.Count * 2).Value = .Resize(.Rows.Count * 2).Value '<--| get rid of formulas
End With
Copy/PasteSpecial approach (you can choose what to paste - see PasteSpecial() method)
With Range("E2", Cells(Rows.Count, "E").End(xlUp))
.Copy
.Offset(.Rows.Count).Resize(.Rows.Count * 2).PasteSpecial ' you have some options like xlPasteAll (pastes all) or xlPasteValues (pastes values only)and others
Application.CutCopyMode = False '<--| this to free clipboard and clear highlighted cells
End With

How to sort excel columns from outlook via VBA. Code excutes by doesn't sort

I'm parsing through a few thousand emails scanning for errors. The parsing code dumps the result into excel unsorted into 4 columns. A: Hits, B: Total, C: Percentage, D: User.
This works fine. However I want to sort this data by total hits (or percentage) without having to do it manually in excel. This is because this is generating up a report with multiple other field groups that I want to sort each set.
The problem is nothing I've come up with is able to actual sort from outlook. The code executes without errors but nothing happens. I was able to use the following to sort in an excel macro successfully.
Sub test()
With ActiveSheet
Call .Range("A3:D30").Sort(Key1:=Range("A3"), Order1:=xlDescending, Header:=xlNo)
End With
End Sub
I then placed just the call line into my outlook vba code, defined everything (Excel Object Library is referenced)
With xlSheet
If i > 0 Then hitp = Round(hits / i * 100, 1) Else hitp = "0"
Dim vstr As Variant
Dim temph As String
j = 2
.Range("A1:D1").Merge
.Range("A1:D1").Value = "Basic Errors"
.cells(j, 1).Value = "Total Hits:"
.cells(j, 2).Value = "Total Sent:"
.cells(j, 3).Value = "Percentage:"
.cells(j, 4).Value = "Agent:"
For Each vstr In userhit.Keys()
j = j + 1
temph = userhit(vstr)
If temph = "" Then temph = "0"
.cells(j, 1).Value = temph
.cells(j, 2).Value = userhit(vstr) + userclean(vstr)
.cells(j, 3).Value = Round(userhit(vstr) / (userhit(vstr) + userclean(vstr)) * 100, 1) & "%"
.cells(j, 4).Value = vstr
DoEvents
Next
Call .Range("A3:D30").Sort(Key1:=Range("A3"), Order1:=xlDescending, Header:=xlNo)
End With
I'm using dictionaries (14 of them) to track various things which is why sorting them in vba before dumping would be far more tedious though possibly doable if I get desperate. Sadly this doesn't sort anything in Excel despite running without errors and working if I copy it into an excel macro.
I've also seen another way of doing the sort like shown in this post https://stackoverflow.com/questions/22220127/sorting-excel-range-in-class-module-from-outlook-or-access-vba
With xlSheet.Sort
.SetRange Range((LeftColStr & RowStart & ":" & RightColStr & RowEnd))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
But in the end that didn't work for him or me when I tried. So I switched to this current method thinking it would be easier but it's not. The code does work if it's in an excel macro, but despite executing in outlook it doesn't work. Any help would be massively appropriated.
So thanks to #A.S.H for the tip of the missing '.'
It worked in excel without it since they have a default of using the active sheet. It now works!
Call .Range("A3:D30").Sort(Key1:=.Range("A3"), Order1:=xlDescending, Header:=xlNo)

How to loop through rows, save these as variables and use them as variables VBA

I'm trying to store values in sheets as a variable, and then go on to reference a sheet using that variable as well as use it to filter by.
This will be looped through until the program reaches the first empty cell.
The relevant code I have so far is:
Sub Program()
Dim i As Integer
i = 2
Do Until IsEmpty(Cells(i, 1))
Debug.Print i
Sheets("Button").Activate
Dim First As String
First = Cells(i, 1).Value
Debug.Print First
Dim Second As String
Second = Cells(i, 2).Value
Debug.Print Second
'Filters my Data sheet and copies the data
Sheets("DATA").Activate
Sheets("DATA").Range("A1").AutoFilter _
Field:=2, _
Criteria1:=First 'Filters for relevant organisation
Sheets("DATA").Range("A1").AutoFilter _
Field:=6, _
Criteria1:="=" 'Filters for No Response
Sheets("DATA").Range("A1:H6040").Copy
'This should loop through for each separate group
Sheets(CStr(Second)).Select
Range("A1").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
i = i + 1
Loop
Worksheets("DATA").AutoFilterMode = False
End Sub
I have changed the program significantly trying to add notation such as 'CStr' as there was an error at this line:
Sheets(CStr(Second)).Select when it used to say Sheets(Second)).Select
and the debug.print's to see if it is actually working but it isn't logging to the Immediate Window.
Additionally, when I actually run it, no error comes up but nothing seems to happen.
Not sure what else to add, or what else to try. Cheers!
As a first remark, using (at least the first) sheet activation within the loop seems unnecessary, because the start of the loop is what determines which sheet is being used to control the flow of the loop.
Furthermore, I would argue that it is better to remove the sheet activation altogether, re: the discussion about .Select (the cases aren't the same, but the solution discussed herein works better for both .Select and .Activate in almost all instances): How to avoid using Select in Excel VBA macros.
Let's also see if we can refer to the table in the "DATA" sheet in a more direct manner, as well as do some errorchecking.
My suggestion:
Sub Program()
Dim i As Integer
Dim First, Second As String
Dim secondWs As Worksheet
Dim dataTbl As ListObject
i = 2
Set dataTbl = Worksheets("DATA").Range("A1").ListObject.Name
' The above can be done more elegantly if you supply the name of the table
Sheets("DATA").Activate
Do Until IsEmpty(Cells(i, 1))
Debug.Print i
First = Sheets("Button").Cells(i, 1).Value
Debug.Print First
Second = Sheets("Button").Cells(i, 2).Value
Debug.Print Second
'Filters my Data sheet and copies the data
dataTbl.AutoFilter _
Field:=2, _
Criteria1:=First 'Filters for relevant organisation
dataTbl.AutoFilter _
Field:=6, _
Criteria1:="=" 'Filters for No Response
Sheets("DATA").Range("A1:H6040").Copy
'This should loop through for each separate group
On Error Resume Next
Set secondWs = Worksheets(Second)
On Error GoTo 0
If Not secondWs Is Nothing Then
secondWs.Range("A1").PasteSpecial Paste:=xlPasteValues
Else
Debug.Print "Sheet name SECOND was not found"
End If
i = i + 1
Loop
Worksheets("DATA").AutoFilterMode = False
End Sub
If you get any errors, please state which line it appears on and what the error message actually is.
Ref:
http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html#post13739

Copying / Pasting Data From One Excel to Another - Dropbox/Combobox error

I am trying to copy data from one Excel workbook to another.
We had a change in the template of an import file, and it has thus ruined the old import files. So there are some files that still need to be imported, but they are under the old template.
My issue stems from when I try to copy the data (paste special, values, anything tried) it gives me an error sometimes: "The Cell or chart that you are trying to change is protected and therefore read-only".
However, that isn't exactly the case. I've determined that it gives that error when I paste a blank cell onto a new field that has a drop-down with Yes or No. Yet, if I manually go to that cell and give it something blank (hit backspace + enter), it has no problems.
I've tried coding so it copy/paste's each line at a time from workbook to workbook, but my problem still remains for these cells that require a drop-down answer. I'm thinking that these cells need to be coded to actually be "typed" instead of pasted. It can't be a part of pasting the actual range.
Does anyone have an idea of how best to resolve this? Below is my current code, it is copying based on the range(s). It's very sloppy as the only way I can think is to keep switching from workbook to workbook. Any help is greatly appreciated.
Also, I'm not 100% on how to calculate the LastRow? So I just have it entered manually.
Sub MoveText()
For Row = 5 To 962
Workbooks("Data.xls").Activate
ActiveSheet.Range(Cells(Row, 1), Cells(Row, 3)).Select
Selection.Copy
Workbooks("blankTemplate.xls").Activate
ActiveSheet.Range(Cells((Row + 1), 1), Cells((Row + 1), 3)).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("data.xls").Activate
ActiveSheet.Range(Cells(Row, 5), Cells(Row, 29)).Select 'this will select the contents of the active row
Workbooks("blankTemplate.xls").Activate
ActiveSheet.Range(Cells((Row + 1), 5), Cells((Row + 1), 29)).Select
Selection.PasteSpecial Paste:=xlPasteValues
Next
Sub MoveText()
Dim shtData As Worksheet, shtTempl As Worksheet
Dim Row As Long
Set shtData = Workbooks("Data.xls").Sheets("Data") 'or e.g. .Sheets(1)
Set shtTempl = Workbooks("blankTemplate.xls").Sheets("Data")
For Row = 5 To 962
shtTempl.Cells(Row + 1, 1).Resize(1, 3).Value = _
shtData.Cells(Row, 1).Resize(1, 3).Value
shtTempl.Cells(Row + 1, 5).Resize(1, 25).Value = _
shtData.Cells(Row, 5).Resize(1, 25).Value
Next Row
End Sub

Moving a Do Until function across columns in excel vba

I'm pretty new to VBA and having trouble creating a quick macro used to move blocks of numbers around.
What I am trying to create is a button that when pressed:
Moves the contents of (i,5) to E63
The cells from (i, 16) down to F67:F110
Dependant on whether Row 10 contains "Low" or "High" moves three cells from the set
N106:N109 to the cells (i12:i14) [Where i is the column reference).
The Range sections of code are what accomplish this and they are working fine, the problem I am having is with my Do.Until row and with the reference Column(i)
Does anyone know how this could work? Thanks
UPDATE
So thanks to the help of Siddharth I've been able to fix all but one bit, which is the lines where there is a string in the Range function. The reason I am not using .Formula here but Paste instead is that otherwise all of the cells A12:A14 to Z12:Z14 will equal the same thing which isn't correct. On the other parts that doesn't matter. I am getting a type 13 mismatch error on these lines.
Sub Columntest()
Dim i As Integer
i = 5
Do Until Cells(5, i).Value = ""
If Cells(10, i).Value = "Low" Then
Range("E63").Formula = Cells(5, i)
Range("F67:F110").Formula = Cells(16, i)
Range("O106:O108").Copy
Range("=" & Columns(i) & "12").PasteSpecial Paste:=xlPasteValues
End If
If Cells(10, i).Value = "High" Then
Range("E63").Formula = Cells(5, i)
Range("F67:F110").Formula = Cells(16, i)
Range("N106:N108").Copy
Range(Columns(i) & "12").PasteSpecial Paste:=xlPasteValues
End If
i = i + 1
Loop
End Sub
The type mismatch is because you are trying to concatenate a column object and a string in the range reference:
Range("=" & Columns(i) & "12").PasteSpecial Paste:=xlPasteValues
Try using this instead:
Cells(12, i).PasteSpecial Paste:=xlPasteValues