Do while loop code wont play - vba

I am trying to loop through a list of data then and copy the rows that contain "WIP" into a second tab. yet the code will nor do anything when I hit execute. Can someone explain why?
Thank you.
Sub Update_LvL1_WIP()
Dim BrowFi As Integer
Dim BrowWIP1 As Integer
Dim dblSKU As Double
Dim strDescription As String
Dim strType As String
BrowFi = (ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row) + 1
Do While BrowFi > 4
If Range("G" & BrowFi).Value = "WIP" Then
strType = Range("G" & BrowFi).Value
strDescription = Range("F" & BrowFi).Value
dblSKU = Range("E" & BrowFi).Value
Worksheets("WIP 1").Activate
BrowWIP1 = (ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row) +1
Range("A" & BrowWIP1).Value = dblSKU
Range("B" & BrowWIP1).Value = strDescription
Range("B" & BrowWIP1).Value = strType
Else
BrowFi = BrowiF - 1
End If
Loop
End Sub

You have a typo in your decrement variable
BrowFi = BrowiF - 1
should be
BrowFi = BrowFi - 1
Since BrowiF was not defined it was treated as 0 and so you were setting BrowFi to -1 on the first run through the loop.
It may be worth using Option Explicit to help catch these errors.

Related

Loops and "i" - Correctly inputting "i"

I have no idea how to add in the "i" to the following code. I've gone through previous questions, but I can't get this to run properly. Ideas? Starting after "ELSE", I have no idea how to add in the "i". Any help would be appreciated.
For i = 2 To myLastRow
Set mycell = myWorksheet.Range("AK" & i)
Set mycell2 = myWorksheet.Range("AD" & i)
Else
**mycell.Offset(, 2).Formula = "==IF(ABS(AJ" & i & " - AL" & i & ") <= AL" & i & "*0.1, TRUE, FALSE) "**
Dim i As Integer
Dim mylastrow As Integer
Dim myworksheet As Worksheet
Dim mycell As Range
Dim mycell2 As Range
Set myworksheet = Sheet1
mylastrow = 10
For i = 2 To mylastrow
Cells(i, "AK").Offset(, 2).Formula = "=IF(ABS(AJ" & i & " - AL" & i & ") <= AL" & i & "*0.1, TRUE, FALSE) "
' Cells(i, "AD").Value
Next i
Are you trying to do something like this? The cells property works perfect for thse types of loops.

objReminder.Start = Range("h" & i) not working

I have this code:
Sub StoreReminders()
Dim LastRow As Long
Dim i As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
i = 2
Debug.Print LastRow
Dim appOL As Object
Dim objReminder As Object
Set appOL = GetObject(, "Outlook.application")
Set objReminder = appOL.CreateItem(1) ' olAppointmentItem
For i = 2 To LastRow
Debug.Print i
Debug.Print Range("h" & i)
objReminder.Start = Range("h" & i)
objReminder.Duration = Range("I" & i)
objReminder.Subject = "Renew " & Range("a" & i)
objReminder.ReminderSet = True
objReminder.Save
Next i
End Sub
It breaks at objReminder.Start = Range("h" & i) because according to the Debug.Print code, it is returning the entire column of dates instead of just the date in H2
Does the Range("a" & i) code not work in conjunction with objReminder.Start?
Debug.print prints it out correctly.
If you check the MSDN entry for the Start property then it says:
Returns or sets a Date indicating the starting date and time for the appointment or Journal entry. Read/write.
(their emphasis)
So, in your VBA code, I would change this line:
objReminder.Start = Range("h" & i)
To this:
objReminder.Start = CDate(Range("h" & i).Value)
Using the CDate function which converts a value to a date.

Why is my Excel VBA code to copy a cell so slow?

I have 2 worksheets in the same workbook. If a cell in SourceSheet meets certain criteria, I want to copy several non-adjacent cells in the same row to NewSheet. The problem is that it's taking over a half second to paste each and every cell, making the macro far too slow. The code below takes 8 seconds to complete a single loop. Is there a faster way I could do this?
Dim EnrollmentChanges As Range
Dim course1 As Range
Dim course1status As Range
Dim row As Long
Dim lrow As Long
Dim NewSheetRow As Long
'This is a dynamic named range
Set EnrollmentChanges = Sheets("SourceSheet").Range("Source")
NewSheetRow = 0
lrow = Sheets("SourceSheet").Range("A1").End(xlDown).row
For row = 2 To lrow
With EnrollmentChanges
course1 = Sheets("SourceSheet").Range("A" & row)
If course1 <> "" Then
course1status = Sheets("SourceSheet").Range("BS" & row)
If InStr(1, course1, "APEX") And course1status = "1" Then
NewSheetRow = NewSheetRow + 1
Sheets("NewSheet").Range("A" & NewSheetRow) = NewSheetRow
Sheets("NewSheet").Range("B" & NewSheetRow) = "W"
Sheets("NewSheet").Range("C" & NewSheetRow) = "S"
Sheets("NewSheet").Range("D" & NewSheetRow) = "MySchool"
Sheets("SourceSheet").Range("B" & row).Copy Sheets("NewSheet").Range("G" & NewSheetRow)
Sheets("SourceSheet").Range("W" & row).Copy Sheets("NewSheet").Range("H" & NewSheetRow)
Sheets("SourceSheet").Range("V" & row).Copy Sheets("NewSheet").Range("J" & NewSheetRow)
Sheets("SourceSheet").Range("Y" & row).Copy Sheets("NewSheet").Range("K" & NewSheetRow)
Sheets("NewSheet").Range("L" & NewSheetRow) = "OR"
Sheets("SourceSheet").Range("B" & row).Copy Sheets("NewSheet").Range("M" & NewSheetRow)
Sheets("SourceSheet").Range("A" & row).Copy Sheets("NewSheet").Range("P" & NewSheetRow)
End If
Else: GoTo NextRow
End If
End With
NextRow:
Next
The best way to approach this would to be avoiding copy and paste altogether (which are notoriously slow). The only time that copy/paste MAY be worth keeping is when you need to copy formatting. If you just need the values then you can do something like this:
Dim EnrollmentChanges As Range
Dim course1 As Range
Dim course1status As Range
Dim row As Long
Dim lrow As Long
Dim NewSheetRow As Long
'This is a dynamic named range
Set EnrollmentChanges = Sheets("SourceSheet").Range("Source")
NewSheetRow = 0
lrow = Sheets("SourceSheet").Range("A1").End(xlDown).row
For row = 2 To lrow
With EnrollmentChanges
course1 = Sheets("SourceSheet").Range("A" & row)
If course1 <> "" Then
course1status = Sheets("SourceSheet").Range("BS" & row)
If InStr(1, course1, "APEX") And course1status = "1" Then
NewSheetRow = NewSheetRow + 1
With Sheets("NewSheet")
.Range("A" & NewSheetRow).Value = NewSheetRow
.Range("B" & NewSheetRow).Value = "W"
.Range("C" & NewSheetRow).Value = "S"
.Range("D" & NewSheetRow).Value = "MySchool"
.Range("G" & NewSheetRow.Value = Sheets("SourceSheet").Range("B" & row).Value
.Range("H" & NewSheetRow).Value = Sheets("SourceSheet").Range("W" & row).Value
.Range("J" & NewSheetRow).Value = Sheets("SourceSheet").Range("V" & row).Value
.Range("K" & NewSheetRow).Value = Sheets("SourceSheet").Range("Y" & row).Value
.Range("L" & NewSheetRow).Value = "OR"
.Range("M" & NewSheetRow).Value = Sheets("SourceSheet").Range("B" & row).Value
.Range("P" & NewSheetRow).Value = Sheets("SourceSheet").Range("A" & row).Value
End With
End If
' No need for this since you are skipping the operation using the if block
' GoTo is messy and should be avoided where possible as well.
'Else: GoTo NextRow
End If
End With
NextRow:
Next
All I did was swap the order and assign the value directly based on the value retrieved versus storing the value retrieved as a copy, and putting it in a new location. Once you practice this a bit it will make much more sense (and it will speed up your code considerably).
As noted at the beginning, if you need formatting kept then that is a bit different.
Also, I didnt bother with optimizing or indenting any of the other elements of your code, but you will want to clean it up with proper indenting and skipping things like "GoTo".
call this sub a the top of you macro:
Sub MakeItFaster()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
End Sub

VBA in Excel returning Type mismatch

I'm trying to create a Macro that will modify contents in columns S, W and AH based on the content in AB
e.g. if AB1 = No, then S1=C-MEM, AH = N/A and W is cleared.
For some reason, I get a 'Type mismatch' error on the first line of my if statement and can't figure out why or how to fix it - even after reading other posts about similar issue.
Sub test()
Dim lastrow As Long
Dim i As Long
lastrow = Range("AB" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
**-> If Range("AB" & i).Value = "No" Then
Range("S" & i).Value = "C-MEM"
Range("W" & i).Value = ""
Range("AH" & i).Value = "N/A"
End If
Next i
End Sub
Thanks
You are trying to test if an error is = No.
Test for the error and skip the logic in that loop:
Sub test()
Dim lastrow As Long
Dim i As Long
lastrow = Range("AB" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Not IsError(Range("AB" & i).Value) Then
If Range("AB" & i).Value = "No" Then
Range("S" & i).Value = "C-MEM"
Range("W" & i).Value = ""
Range("AH" & i).Value = "N/A"
End If
End If
Next i
End Sub

Need a real VBA equivalent for Excel Value function

As mentioned in the title, I need a VBA equivalent to the Excel Value function. My data set looks like this: Data set example
What I am looking for is VBA code equivalent to this: =Value(A2)+Value(B2). That would go in column C
The output must be the same as that function. For the given example, column C should end up looking like this: End product
More than that, it needs to only have the value in the cell after the macro is run, rather than displaying the value and still having that formula in it.
Here is what I have done so far:
For i = 1 To LastRow
strValue = Val(sht.Range("A" & i))
strValue1 = Val(sht.Range("B" & i))
sht.Range("C" & i).Value = strValue + strValue1
Next i
I also tried variations on this, a couple of which are shown below:
For i = 1 To LastRow
strValue = Evaluate(sht.Range("A" & i))
strValue1 = Evaluate(sht.Range("B" & i))
sht.Range("C" & i).Value = strValue + strValue1
Next i
For i = 1 To LastRow
strValue = sht.Range("A" & i)
strValue1 = sht.Range("B" & i)
strVal = Evaluate(strValue)
strVal1 = Evaluate(strValue1)
sht.Range("C" & i).Value = strVal + strVal1
Next i
I can't find anything that will work for me. The output in C for the example set ends up being just 9. Pretty sure it is taking the first number in A and adding it to the first number in B. So when the hour in B changes to 1 C displays 10.
I also tried simply:
For i=1 To LastRow
sht.Range("C" & i).Value = sht.Range("A" & i).Value + sht.Range("B" & i).Value
Next i
That just concatenated the text to the format 9/03/15 00:00:00
Any and all help appreciated. Bonus if you can point me in the right direction for changing the final C values from that number (ie. 42250.00017) to the custom date/time format 'yyyy-mm-dd hh:mm:ss'.
Edit: Here is my code up to the sticking point. Everything else works as I want it to, the only problem is with the last For loop.
Sub sbOrganizeData()
Dim i As Long
Dim k As Long
Dim sht As Worksheet
Dim LastRow As Long
Dim sFound As String
Dim rng As Range
Dim sheet As Worksheet
Dim Sheet2 As Worksheet
Dim strFile As String
Dim strCSV As String
Dim strValue As Double
Dim strValue1 As Double
Dim strVal As Long
Dim strVal1 As Long
Application.DisplayAlerts = False
Sheets("all016").Delete
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
Set sheet = Sheets.Add
Set Sheet2 = Sheets.Add
sheet.Name = "all016"
Sheet2.Name = "Sheet1"
strFile = ActiveWorkbook.Path
strCSV = "*.csv"
sFound = Dir(strFile & "\*.csv")
If sFound <> "" Then
Workbooks.Open Filename:=strFile & "\" & sFound
End If
Range("A1").CurrentRegion.Copy Destination:=Workbooks("solar.xlsm").Sheets("all016").Range("A1")
Workbooks(sFound).Close
Set sht = ThisWorkbook.Sheets("all016")
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
sht.Range("C1").EntireColumn.Insert
For i = 1 To LastRow
'Code that doesn't quite work here'
sht.Range("C" & i).NumberFormat = "yyyy-mm-dd hh:mm:ss"
Next i
The issue is that the dates and times are strings so something like this will work:
For i = 2 To LastRow
strValue = Evaluate("VALUE(TRIM(" & sht.Range("A" & i).Address(1,1,,1) & "))")
strValue1 = Evaluate("VALUE(TRIM(" & sht.Range("B" & i).Address(1,1,,1) & "))")
sht.Range("C" & i).Value = strValue + strValue1
'the format
sht.Range("C" & i).NumberFormat = "mm/dd/yy hh:mm:ss"
Next i
You have to reference the .Value2 field of the range element as:
For i = 1 To LastRow
sht.Range("C" & i).Value2 = sht.Range("A" & i).Value2 + sht.Range("B" & i).Value2
Next i
The value is free of formatting and just in Excel's time/date code as you want your final result to be. Cheers,