How can I implement if Sheet1 has row16 filled with anything it'll continue the function. If row16 is blank then skip function?
Initially I wanted row 2 to row15 from sheet1 to be copied into sheet2 and anything from row16 will be put on sheet3.
The code I have currently works fine with anything over 15 rows of data. But if it gets below 15 rows it gets buggy.
With Sheets("sheet1")
Set Rng = .Range("T2:T15")
End With
For i = 1 To Rng.Count * 2 Step 2
r = r + 1
Sheets("Sheet2").Range("C" & i + 13).Value = Rng(r).Value
Sheets("Sheet2").Range("D" & i + 14).Value = Rng(r).Value
Next i
With Sheets("sheet1")
Set Rng2 = .Range("T16", .Range("T" & Rows.Count).End(xlUp))
End With
For i2 = 1 To Rng2.Count * 2 Step 2
r2 = r2 + 1
Sheets("Sheet3").Range("C" & i2 + 7).Value = Rng2(r2).Value
Sheets("Sheet3").Range("D" & i2 + 8).Value = Rng2(r2).Value
Next i2
CountBlank vs CountA
Replace your second With block with the following one:
CountBlank
With Sheets("sheet1")
If Application.CountBlank(.Rows(16)) = .Columns.Count Then
Exit Sub
Else
Set Rng2 = .Range("T16", .Range("T" & Rows.Count).End(xlUp))
End If
End With
CountA
In this case, If Application.CountA(.Rows(16)) = 0 Then is unreliable because it will 'pick up' any cells containing formulas evaluating to "". Although sometimes you might need this behavior.
If you just want to check cell T16 do the following:
Len
With Sheets("sheet1")
If Len(.Range("T16").Value) = 0 Then
Exit Sub
Else
Set Rng2 = .Range("T16", .Range("T" & Rows.Count).End(xlUp))
End If
End With
I have created a method for defining range between two words and iterate through it to copy paste values from one worksheet to another. There is some strange reason it does not work.
I specify row, it is 18, my code starts from row 20? So it copies everything starting from row 20. O_o
It does not detect range correctly as it copies values below my words as well? I have checked that I don't have same words elsewhere.
Any suggestions?
Here is code for calling method:
Sub dsfdsfdsfds()
copyOptionsToTable 18, CalculationItemOM1
End Sub
Here is method:
Private Sub copyOptionsToTable(RowToPaste As Integer, OperatingWorksheet As Worksheet)
'Dim FirstWord, SecondWord
Dim OptionsRange As Range
Dim cell, x
'Set FirstWord = OperatingWorksheet.Range("W:W").Find("OPTIOONS START", LookIn:=xlValues, lookat:=xlWhole)
'Set SecondWord = OperatingWorksheet.Range("W:W").Find("OPTIOONS END", LookIn:=xlValues, lookat:=xlWhole)
Set OptionsRange = OperatingWorksheet.Range(OperatingWorksheet.Cells.Find("[OPTIOONS START]"), OperatingWorksheet.Cells.Find("[OPTIOONS END]"))
x = 0
' Copy - Paste process
For Each cell In OptionsRange
If Not IsEmpty(cell.Value) Or cell.Value <> "OPT" Then
ThisWorkbook.Worksheets("TableForOL").Range("B" & RowToPaste).Offset(0 + x, 0).Value = cell.Offset(0 + x, -20).Value
ThisWorkbook.Worksheets("TableForOL").Range("B" & RowToPaste).Offset(0 + x, 3).Value = cell.Offset(0 + x, 2).Value
End If
x = x + 1
Next cell
End Sub
Source sheet:
Output sheet:
EDIT:
Output still looks like this?
You're already incrementing cell by one row inside the loop - you don't need to further offset that using x
Set OptionsRange = OperatingWorksheet.Range( _
OperatingWorksheet.Cells.Find("[OPTIOONS START]").Offset(1,0), _
OperatingWorksheet.Cells.Find("[OPTIOONS END]").Offset(-1, 0))
x = 0
' Copy - Paste process
For Each cell In OptionsRange.Cells
If Not IsEmpty(cell.Value) Or cell.Value <> "OPT" Then
With ThisWorkbook.Worksheets("TableForOL").Range("B" & RowToPaste)
.Offset(x, 0).Value = cell.Offset(0, -20).Value
.Offset(x, 3).Value = cell.Offset(0, 2).Value
End With
x = x + 1 '<< only increment if you copied values...
End If
Next cell
Also I'm not sure this line does what you intend?
If Not IsEmpty(cell.Value) Or cell.Value <> "OPT" Then
maybe
If Not IsEmpty(cell.Value) And cell.Value <> "OPT" Then
I have a workbook with multiple sheets, and new sheets will be added regularly, titled by [mmm yy] format. In my main sheet ("ContactList"), I have an IF formula with a 'nested' VLOOKUP formula in three columns to pull the respective numbers from the appropriate sheet, and I have a cell that has the date in the format I want. I want my script to look at the cell with the date in it, and use that cell's value to update the columns of VLOOKUP formulas to match that. For example, in February, the cell on my main sheet will say "Feb 20", so my VLOOKUP formulas will look in the sheet titled "Feb 20". In March, that cell will update, and I want my script (preferably automatically but tied to a button is alright) to update all the VLOOKUP functions to now be looking in the "Mar 20" sheet.
I feel like I've been trying a million things and keep getting various errors, but I'm just stuck now. My latest attempt was to set the parts of the formula as variables, then set other variables to be those parts parsed together.
Sub Update_Counts()
Dim rng As Range
Dim cellnum As Integer
Dim curr As Object
Dim v1 As String, v2 As String, v3 As String, v4 As String, v5a As String, v5b As String, v5c As String
Dim v6a As String, v6b As String, v6c As String, strFormC As String, strFormMR As String, strFormMD As String
v1 = "=IF(VLOOKUP("
v2 = Cells(cell.Row, "A")
v3 = ",'"
v4 = Cells(1, 6).Value
v5a = "'!B7:F50, 2, FALSE) = 0, 'EMPTY', VLOOKUP("
v5b = "'!B7:F50, 3, FALSE) = 0, 'EMPTY', VLOOKUP("
v5c = "'!B7:F50, 4, FALSE) = 0, 'EMPTY', VLOOKUP("
v6a = "'!B7:F50, 2, FALSE))"
v6b = "'!B7:F50, 3, FALSE))"
v6c = "'!B7:F50, 4, FALSE))"
strFormC = v1 & v2 & v3 & v4 & v5a & v2 & v3 & v4 & v6a
strFormMR = v1 & v2 & v3 & v4 & v5b & v2 & v3 & v4 & v6b
strFormMD = v1 & v2 & v3 & v4 & v5c & v2 & v3 & v4 & v6c
Set curr = Worksheets("ContactList").Cells(cellnum, 6)
Set rng = Sheets("ContactList").Range("F3:H55")
For cellnum = 3 To 55
If Cells(2, 6).Value = "Commercial Total" Then
curr.Value = strFormC
ElseIf Cells(2, 7).Value = "Medicare" Then
curr.Value = strFormMR
ElseIf Cells(2, 8).Value = "Medicaid" Then
curr.Value = strFormMD
End If
Next cellnum
End Sub
That's what I have thus far. I'm currently getting "Run-time error '424'; Object Required". I had thought having curr as an object would allow me to get through it, but I think my cellnum value is the "needs to be an object" portion of the For statement. However, I'm not sure how to get the cell values in there without how it's set up. I had tried a "For Each" loop but got a myriad of issues there as well. I wasn't able to find any examples of people wanting to update their cells' formulas by including a cell value, but perhaps I just wasn't looking in the right spot. Any advice is much appreciated!
As I put in my comment, you don't need to use VBA to achieve this.
If I'm reading your code correctly, I think you just need the following formula in cell A3 and copy it down:
=IF(VLOOKUP($A3,INDIRECT("'"&$F$1&"'!B7:F50"),IF($F$2="Commercial Total",2,IF($G$2="Medicare",3,IF($H$2="Medicaid",4,1))),FALSE)=0,"EMPTY",VLOOKUP($A3,INDIRECT("'"&$F$1&"'!B7:F50"),IF($F$2="Commercial Total",2,IF($G$2="Medicare",3,IF($H$2="Medicaid",4,1))),FALSE))
This is on the assumptions I've made from reading your code that:
Cell F1 contains the name of the sheet you want to get the data from.
One of Cells F2, G2 and H2 will contain the keywords Commercial Total, Medicare and Medicaid respectively.
If you want some code though, this is how I'd build the LOOKUP flexibly:
Sub Update_Counts()
Dim rng As Range
With Sheets("ContactList")
Set rng = .Range("F3:F55")
lookupformula = "=IF(VLOOKUP(A<rownum>,'<sheetname>'!B7:F50,<colnum>,FALSE)=0,""EMPTY"",VLOOKUP(A<rownum>,'<sheetname>'!B7:F50,<colnum>,FALSE))"
For Each c In rng.Cells
sheetname = .Cells(1, 6).Value
thisrow = c.Row
If .Cells(2, 6).Value = "Commercial Total" Then
colnum = 2
ElseIf .Cells(2, 7).Value = "Medicare" Then
colnum = 3
ElseIf .Cells(2, 8).Value = "Medicaid" Then
colnum = 4
End If
finalformula = Replace(Replace(Replace(lookupformula, "<rownum>", thisrow), "<sheetname>", sheetname), "<colnum>", colnum)
c.Formula = finalformula
Next
End With
End Sub
I figured it out from #CLR 's answer, thank you! I was struggling because I figured out the date value to stop the script from trying to import a new document, but the If/ElseIf criteria were getting a little muddied. Since the headers all always existed, it was inputting the last condition across the board, meaning I was getting column 3 data for all three columns. I am sure there's a neater way to do it, but at least for me, I'm happy with splitting the three functions and having a button run all three.
Private Sub CommandButton1_Click()
Update_Counts_COM
Update_Counts_MR
Update_Counts_MD
End Sub
Sub Update_Counts_COM()
Dim rng As Range
With Sheets("ContactList")
Set rng = .Range("F3:F21,F24:F27,F30:F51")
lookupformula = "=IFERROR(IF(VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)=0,""EMPTY"",VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)), ""Not Found"")"
For Each c In rng.Cells
sheetname = .Cells(1, 6).Value
thisrow = c.Row
If .Cells(2, 6).Value = "Commercial Total" Then
colnum = 2
End If
finalformula = Replace(Replace(Replace(lookupformula, "<rownum>", thisrow), "<sheetname>", sheetname), "<colnum>", colnum)
c.Formula = finalformula
Next
End With
End Sub
Sub Update_Counts_MR()
Dim rng As Range
With Sheets("ContactList")
Set rng = .Range("G3:G21,G24:G27,G30:G51")
lookupformula = "=IFERROR(IF(VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)=0,""EMPTY"",VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)), ""Not Found"")"
For Each c In rng.Cells
sheetname = .Cells(1, 6).Value
thisrow = c.Row
If .Cells(2, 7).Value = "Medicare" Then
colnum = 3
End If
finalformula = Replace(Replace(Replace(lookupformula, "<rownum>", thisrow), "<sheetname>", sheetname), "<colnum>", colnum)
c.Formula = finalformula
Next
End With
End Sub
Sub Update_Counts_MD()
Dim rng As Range
With Sheets("ContactList")
Set rng = .Range("H3:H21,H24:H27,H30:H51")
lookupformula = "=IFERROR(IF(VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)=0,""EMPTY"",VLOOKUP(A<rownum>,'<sheetname>'!B7:F59,<colnum>,FALSE)), ""Not Found"")"
For Each c In rng.Cells
sheetname = .Cells(1, 6).Value
thisrow = c.Row
If .Cells(2, 8).Value = "Medicaid" Then
colnum = 4
End If
finalformula = Replace(Replace(Replace(lookupformula, "<rownum>", thisrow), "<sheetname>", sheetname), "<colnum>", colnum)
c.Formula = finalformula
Next
End With
End Sub
was what ended up working for me! Thanks everyone :)
I have a simple problem for which I can't find a solution to. I can get values into a MsgBox in my code in Excel as for example: aaaaaaaa, bbbbbbbb, cccccccc, dddddddd etc. I would like to get the comma separated values from this MsgBox into cells starting from for example C15, C16, C17, C18 etc. as following:
C15: aaaaaaaa
C16: bbbbbbbb
C17: cccccccc
C18: dddddddd
C19: etc.
I can't find a solution to my problem although I have tried to Google an answer for a couple of hours. All help appreciated!
Sub ComSepList()
Dim lr As Long, rng As Range, c As Range, fLoc As Range
Dim fAdr As String, rngOut As Range
Dim xArr() As String
Dim tttt As String
lr = Cells(Rows.Count, 2).End(xlUp).Row
Set rngOut = Range("C15")
Set rng = Range("B2:B" & lr)
For Each c In rng
'MsgBox c
Set fLoc = Range("A:A").Find(c.Value, , xlValues)
If Not fLoc Is Nothing Then
fAdr = fLoc.Address
Do
If fLoc.Offset(0, 6) = "1" Then
c.Offset(0, 4) = c.Offset(0, 4).Value & fLoc.Offset(0, 7).Value & ", "
End If
fLoc.Value = c.Value
Set fLoc = Range("A:A").FindNext(fLoc)
Loop While fAdr <> fLoc.Address
tttt = Left(c.Offset(0, 4).Value, Len(c.Offset(0, 4).Value) - 1)
End If
'Columns("F").AutoFit
Next
MsgBox tttt
rngOut.Resize(UBound(Split(tttt.Text, ","))).Value = Application.Transpose(Split(tttt.Text, ","))
End Sub
Sub kjlkjlkj()
Dim t As String
t = InputBox("String")
ActiveSheet.Range("C15").Resize(UBound(Split(t, ",")) + 1).Value = _
Application.Transpose(Application.Trim(Split(t, ",")))
End Sub
I need to create a VBA script in excel that chanages an order number from having "CD" at the front to "CD" at the end so from "CD00001" to "00001CD"
Any help would be awesome. all of the order numbers are in Column B and start at row 5. please help.
What i have so far:
Private Sub OrderNumber_Click()
Dim Val As String
Dim EndC As Integer
EndC = Worksheets("Raw Data Upload").Range("A1048576").End(xlUp).Row
For i = 5 To EndC
Val = Right("B" & i, Len("B" & i) - 2) & Left("B" & i, 2)
Range("B" & i).Value = Val
Next
End Sub
This replaces the order numbers with B5, B6 and so on but if i put this function into Excel itself it works fine.
Like this? DO you want it in column B?
Option Explicit
Private Sub OrderNumber_Click()
Dim i As Long
Dim val As String
Dim EndC As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Raw Data Upload")
EndC = ws.Range("A1048576").End(xlUp).Row
For i = 5 To EndC
val = ws.Cells(i, "A")
Range("B" & i).Value = Mid$(val, 3, Len(val) - 2) & Left$(val, 2)
Next i
End Sub
dim beginStr, endStr, originalStr, outputStr as string
dim rng as range
'put the below into a loop, assigning a rng to the desired cell each time
originalStr = rng.value ' Change to chosen range
beginStr = left(originalStr,2)
endStr = right(originalStr, len(originalStr) - 2)
outputStr = endStr + beginStr
Range("B" & i).Value = outputStr
I haven't got a copy of Excel to test this on but it should work.
Simply use:
Right(Range("B" & i), Len(Range("B" & i)) - 2) & Left(Range("B" & i), 2)
An alternative is to set up the cell as a Range():
Sub t()
Dim cel As Range
Dim endC As Long
endC = Worksheets("Raw Data Upload").Range("A1048576").End(xlUp).Row
For i = 5 To endC
Set cel = Range("B" & i)
myVal = Right(cel, Len(cel) - 2) & Left(cel, 2)
Range("B" & i).Value = myVal
Next
End Sub
Currently, when you do Right("B" & i, Len("B" & i) - 2) & Left("B" & i, 2), for row 5, this becomes Right("B5", Len("B5") - 2) & Left("B5", 2) then this evaluates to simply:
Right("B5",0) & Left("B5",2), which is
[nothing] & B5, finally becoming
B5
Note the lack of using B5as a range. Instead it's being treated as a string.
(Also, I'm assuming this is to be run on the ActiveSheet. If not, please add the worksheet before the range, i.e. Worksheets("Raw Data Upload").Range("B" & i)...)
Try this
Private Sub OrderNumber_Click()
Dim cell As Range
With Worksheets("Raw Data Upload")
For Each cell in .Range("B5", .Cells(.Rows.Count, 2).End(xlUp))
cell.Value = Right(cell.Value, Len(cell.Value) - 2) & Left(cell.Value, 2)
Next
End With
End Sub