How to set range for cells like with formula "102."&H2 and give value 102.1
H2 will give different number after loops
Count = 2
For I = 7 To N
If Range("E" & Count) = Range("E" & I) And Range("A" & I) = "102." & [H2] Then
Something
This is not working "102." & [H2]
If Range("E" & Count) = Range("E" & I) And Range("A" & I) > 0 Then
If i switch with > 0 this works:D
If Range("E" & Count) = Range("E" & I) And Range("A" & I) = "102." & [H2] Then
Something
This is not working with "102." & [H2]
If Range("E" & Count) = Range("E" & I) And Range("A" & I) > 0 Then
If i switch with > 0 this works:D
Related
This is looping through a worksheet that is about 10k rows and it is taking a considerable amount of time. Is there a way to do this faster aside from an array? thank you
For i = 2 To spberowcnt
With spbe30
.Range("b" & i).Value = LCase(.Range("b" & i).Value)
.Range("d" & i).Value = LCase(.Range("d" & i).Value)
.Range("i" & i).Value = LCase(.Range("i" & i).Value)
.Range("j" & i).Value = LCase(.Range("j" & i).Value)
.Range("l" & i).Value = LCase(.Range("l" & i).Value)
.Range("m" & i).Value = LCase(.Range("m" & i).Value)
.Range("n" & i).Value = LCase(.Range("n" & i).Value)
.Range("p" & i).Value = LCase(.Range("p" & i).Value)
.Range("q" & i).Value = LCase(.Range("q" & i).Value)
.Range("r" & i).Value = LCase(.Range("r" & i).Value)
.Range("z" & i).Value = LCase(.Range("z" & i).Value)
.Range("aa" & i).Value = LCase(.Range("aa" & i).Value)
End With
Next i
For i = 2 To spberowcnt
With spbe60
.Range("b" & i).Value = LCase(.Range("b" & i).Value)
.Range("d" & i).Value = LCase(.Range("d" & i).Value)
.Range("i" & i).Value = LCase(.Range("i" & i).Value)
.Range("j" & i).Value = LCase(.Range("j" & i).Value)
.Range("l" & i).Value = LCase(.Range("l" & i).Value)
.Range("m" & i).Value = LCase(.Range("m" & i).Value)
.Range("n" & i).Value = LCase(.Range("n" & i).Value)
.Range("p" & i).Value = LCase(.Range("p" & i).Value)
.Range("q" & i).Value = LCase(.Range("q" & i).Value)
.Range("r" & i).Value = LCase(.Range("r" & i).Value)
.Range("z" & i).Value = LCase(.Range("z" & i).Value)
.Range("aa" & i).Value = LCase(.Range("aa" & i).Value)
End With
Next i
This is the array solution
Sub test()
Application.ScreenUpdating = False
Dim arrWorksheets(1) As Variant, ws As Worksheet
Set arrWorksheets(0) = spbe30
Set arrWorksheets(1) = spbe60
Dim arrColumns As Variant
arrColumns = Array("B", "D", "AA") 'adjust to your needs
Dim arrValues As Variant
Dim iWs As Long, iC As Long, i As Long
For iWs = 0 To UBound(arrWorksheets)
Set ws = arrWorksheets(iWs)
For iC = 0 To UBound(arrColumns)
arrValues = ws.Range(arrColumns(iC) & "2").Resize(spberowcnt).Value
For i = 1 To UBound(arrValues, 1)
arrValues(i, 1) = LCase(arrValues(i, 1))
Next
ws.Range(arrColumns(iC) & "2").Resize(spberowcnt).Value = arrValues
Next
Next
Application.ScreenUpdating = True
End Sub
Alternative: helper columns ...
You could try something like the following, looping over the columns instead of the individual cells and using Evaluate and Lower on the entire column. You could also process adjacent columns together.
cols = Array("B", "D", "I:J", "L:N", "P:R", "Z:AA")
For i = LBound(cols) to Ubound(cols)
Dim col As String
col = cols(i)
With spbe30
Dim rng As Range
Set rng = .Rows("2:" & spberowcnt).Columns(col)
rng.Value = .Evaluate("LOWER(" & rng.Address & ")")
End With
Next
But as mentioned in comments, an array is probably the way to go.
First, I'm new to programming VBA to excel so if this program makes no sense...here's to the learning curve.
I'm trying to concatenate a range from "BO1:BQ" & DLimportLastRow, where DLimportLastRow is the last row of a variable import that was just run before this code. I've done as much internet research as i can, but most of the concatenate codes i found make no sense to me so i can't modify them to meet my needs. The end goal is to concatenate BO1:BQ" & DLimportLastRow with each cell separated by a "," and fitting into one cell which is "AE" & LastRow, where LastRow is the next blank cell in "AE".
DLimportLastRow = WorkEnd.Cells(WorkEnd.Rows.Count, "BO").End(xlUp).Offset(1).Row
DLimportLastRow = "BQ" & DLimportLastRow
i = 1
Do Until IsEmpty(Range("BO" & i).Value) = True Or Range("C" & i).Value = "" Or Range("C" & i).Value = Null Or Range("C" & i).Value = 0
x = Workbooks(WName).Worksheets("ReportGroupingInfo").Range("BO" & i).Value
For Each cell In Range("BO1", DLimportLastRow)
y = x & cell.Value & ","
i = i + 1
Next
Loop
Range("AE" & LastRow).Value = y
Got it:
Dim y as string
i = 1
Do Until IsEmpty(Range("BO" & i).Value) = True Or Range("C" & i).Value = "" Or Range("C" & i).Value = Null Or Range("C" & i).Value = 0
For Each cell In Range("BO1", DLimportLastRow)
y = y & cell.Value & ","
i = i + 1
Next
Loop
Range("AE" & LastRow).Value = y
I have a macro that runs on cell changes but every time I want to run it it keeps giving me "Next without for" or "double declaration within given range"
Here's the code:
Dim Lvl As Range
Set Lvl = Range("A5:A44")
Dim Full, Medium, Poor
Dim r As Long
For r = 5 To 44
Full = StrComp(Range("A" & r), Data.Range("A2"), 0)
Medium = StrComp(Range("A" & r), Data.Range("A3"), 0)
Poor = StrComp(Range("A" & r), Data.Range("A4"), 0)
If Not Intersect(Target, Lvl) Is Nothing Then
Dim i As Integer
For i = r To 44
If Full = 0 Then
Range("I" & r).Value = Application.WorksheetFunction.RoundDown((Range("B" & r) * 1), 0)
ElseIf Medium = 0 Then
Range("I" & r).Value = Application.WorksheetFunction.RoundDown((Range("B" & r) * (3 / 4)), 0)
ElseIf Poor = 0 Then
Range("I" & r).Value = Application.WorksheetFunction.RoundDown((Range("B" & r) * (1 / 2)), 0)
Else
Range("I" & r).Value = 0
End If
If Not Range("A" & r) = Range("A" & r).Offset(-1, 0) And Not Range("A" & r) = A5 Then
If Range("A" & r).Offset(-1, 0) = Full And Range("A" & r) = Medium Then
Range("I" & i).Value = Range("I" & i).Value + 1
ElseIf Range("A" & r).Offset(-1, 0) = Medium And Range("A" & r) = Poor Then
Range("I" & i).Value = Range("I" & i).Value + 1
ElseIf Range("A" & r).Offset(-1, 0) = Full And Range("A" & r) = Poor Then
Range("I" & i).Value = Range("I" & i).Value + 2
End If
End If
Next
End If
Next
The Double Declaration Error I am getting probably has to do with the fact that I am using r = 5 To 44 AND i = r To 44
But I needed a way to get the Range("I" & i).value to work
There is an End If missing right before Next
Dim Lvl As Range
Set Lvl = Range("A5:A44")
Dim Full, Medium, Poor
r = 5
Full = StrComp(Range("A" & r), Data.Range("A2"), 0)
Medium = StrComp(Range("A" & r), Data.Range("A3"), 0)
Poor = StrComp(Range("A" & r), Data.Range("A4"), 0)
If Not Intersect(Target, Lvl) Is Nothing Then
Dim i As Integer
For i = r To 44
If Full = 0 Then
Range("I" & r).Value = Application.WorksheetFunction.RoundDown((Range("B" & r) * 1), 0)
ElseIf Medium = 0 Then
Range("I" & r).Value = Application.WorksheetFunction.RoundDown((Range("B" & r) * (3 / 4)), 0)
ElseIf Poor = 0 Then
Range("I" & r).Value = Application.WorksheetFunction.RoundDown((Range("B" & r) * (1 / 2)), 0)
Else
Range("I" & r).Value = 0
End If
If Not Range("A" & r) = Range("A" & r).Offset(-1, 0) And Not Range("A" & r) = A5 Then
'^^-- this one is not closed by End If
If Range("A" & r).Offset(-1, 0) = Full And Range("A" & r) = Medium Then
'^^-- this is AAA
Range("I" & i).Value = Range("I" & i).Value + 1
ElseIf Range("A" & r).Offset(-1, 0) = Medium And Range("A" & r) = Poor Then
Range("I" & i).Value = Range("I" & i).Value + 1
ElseIf Range("A" & r).Offset(-1, 0) = Full And Range("A" & r) = Poor Then
Range("I" & i).Value = Range("I" & i).Value + 2
End If '<-- this closes the one I marked with AAA
End If '<-- missing here !!!
Next
End If
I am doing an average of data (VBA Excel) as below:
If n < 8 Then
Sheet2.Cells(i, 20).Value = "=SUM(E" & i & ":S" & i & ")/" & n
Else
Sheet2.Cells(i, 20).Value = "=AVERAGE(LARGE(E" & i & ":S" & i & ", {1,2,3,4,5,6,7,8}))"
End If
n = 0
This code is working, because I want the best 8 values of 15 values.
My question is how to do the same with x values (x will be introduced via a userform, 0<x<16).
Of course, I could use a Select Case with 15 lines depending of x, but it does not seem to me a good coding.
Any ideas?
If AVERAGEIF is available:
Sheet2.Cells(i, 20).Value = "=AVERAGEIF(E" & i & ":S" & i & ","">=""&LARGE(E" & i & ":S" & i & "," & x & "))"
For i = 2 and x = 8, the formula is:=AVERAGEIF(E2:S2,">="&LARGE(E2:S2,8))
If not:
Sheet2.Cells(i, 20).Value = "=SUMIF(E" & i & ":S" & i & ","">=""&LARGE(E" & i & ":S" & i & "," & x & "))/" & x
For i = 2 and x = 8, the formula is:=SUMIF(E2:S2,">="&LARGE(E2:S2,8))/8
I'm trying to modify the below function to include logic where if the variables PPD_1_Date, PPD_2_Date and TSpot_Date are all empty (blank) then output to my "Error" worksheet.
I have rows that should fall under this logic, however they are falling under the Else condition instead.
Function PPDdate()
Dim PPD_1_Date As Date
Dim PPD_2_Date As Date
Dim TSpot_Date As Variant
Dim i As Long, j As Long, k As Long
j = Worksheets("PPDCI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow
PPD_1_Date = Worksheets("Data").Range("AW" & i)
PPD_2_Date = Worksheets("Data").Range("BA" & i)
Entity = Worksheets("Data").Range("J" & i)
Dept = Worksheets("Data").Range("M" & i)
TSpot_Date = Worksheets("Data").Range("AS" & i)
If PPD_1_Date > PPD_2_Date Then
Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("PPDCI").Range("F" & j).Value = PPD_1_Date
Worksheets("PPDCI").Range("G" & j).Value = Worksheets("Data").Range("AX" & i).Value
Worksheets("PPDCI").Range("H" & j).Value = Worksheets("Data").Range("AZ" & i).Value
Worksheets("PPDCI").Range("I" & j).Value = Worksheets("Data").Range("AY" & i).Value
j = j + 1
Else
If PPD_1_Date < PPD_2_Date Then
Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("PPDCI").Range("F" & j).Value = PPD_2_Date
'Worksheets("PPDCI").Range("G" & j).Value = "ELSE IF CONDITION"
Worksheets("PPDCI").Range("G" & j).Value = Worksheets("Data").Range("BB" & i).Value
Worksheets("PPDCI").Range("H" & j).Value = Worksheets("Data").Range("BD" & i).Value
Worksheets("PPDCI").Range("I" & j).Value = Worksheets("Data").Range("BC" & i).Value
j = j + 1
Else
'If IsEmpty(Worksheets("Data").Range(PPD_1_Date & i).Value) = True And IsEmpty(Worksheets("Data").Range(PPD_2_Date & i).Value) = True Then
'GoTo EmptyRange
'Else
If (InStr(1, Entity, "CNG Hospital") Or InStr(1, Entity, "Home Health") Or InStr(1, Entity, "Hospice") Or InStr(1, Dept, "Volunteers") Or ((IsEmpty(PPD_1_Date) = True) And (IsEmpty(PPD_2_Date) = True))) And IsEmpty(TSpot_Date) = True Then
Worksheets("Error").Range("A" & k & ":H" & k).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("Error").Range("F" & k).Value = "REVIEW PPD DATA"
k = k + 1
Else
Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("PPDCI").Range("F" & j).Value = TSpot_Date
Worksheets("PPDCI").Range("G" & j).Value = Worksheets("Data").Range("AX" & i).Value
Worksheets("PPDCI").Range("H" & j).Value = Worksheets("Data").Range("AY" & i).Value
Worksheets("PPDCI").Range("I" & j).Value = "NO PPD DATES BUT HAS TSPOT DATE1"
j = j + 1
End If
End If
End If
'EmptyRange:
'k = k + 1
Next i
End Function
Here is the code I added to the other OR logic;
Or ((IsEmpty(PPD_1_Date) = True) And (IsEmpty(PPD_2_Date) = True))
Example row has empty cells in columns AW, BA, and AS, so it should write to my Error worksheet. Is there a syntax or logic issue? I did initially have TSPOT_Date defined as a Date variable, however I was getting a '1004' runtime error (I think because some column rows are empty) so I changed to Variant, however logic still doesn't work as I expect.
The problem you're running into is that you can't check if Date variables are "empty" using isEmpty() or even with Len() because the default value for a date is 30-Dec-1899 00:00:00, so there is always a value in a Date variable.
Instead, you should check to see that a Date variable is empty/has not been filled like this
If PPD_2_Date = 0 Then
...