please help where is the error.
loop without IF?
I need to load the code, check the first 2 values match the cell. Check that you do not duplicate in column A. And retrieve the codes until the required number is reached.
Thank you
My Code:
Sub novy()
Dim aText(1) As Variant
Dim n As Integer
Dim vstup As String
vstup = InputBox(aText(x))
Set hledat = Range("A:A").Find(what:=vstup, LookIn:=xlValues, LookAt:=xlWhole)
If vstup = "" Then ' in case the use press "Cancel"
i = MsgBox("Chcete ukončit načítání?", vbYesNo)
Select Case i
Case vbYes
Exit Sub
Case vbNo
Call novy
End Select
ElseIf Left(vstup, 2) <> Range("D3").Formula Then
i = MsgBox("jiný modul!", vbExclamation)
ElseIf hledat Is Nothing Then
For n = 1 To 10
aText(1) = "Načti kód"
Sheets("data").Select
aLastRow = Cells(1, 1).CurrentRegion.Rows.Count + 1
For x = 1 To 1
Cells(aLastRow, x) = vstup
Next
Cells(10, 9) = n
'MsgBox n
Next n
MsgBox "Bedna je hotová"
Else
i = MsgBox("modul byl už načten!", vbExclamation)
End If
End Sub
You have an error on the the two last for loops. you dont need 2 either with an "x" from 1 to 1..
For n = 1 To 10
aText(1) = "Načti kód"
Sheets("data").Select
aLastRow = Cells(1, 1).CurrentRegion.Rows.Count + 1
Cells(aLastRow, 1) = vstup
Next
Related
I'm trying to create a code in VBA where if the range/column contains the letter a and the cell, C5, is empty, then it will display an error message that the cell is empty. I've been testing this with numbers and have gotten that to work, but I'm having issues with doing it with text. I know the IsEmpty part of the code works because of what I've previously tried.
Sub Null_Test()
'
' Null_Test Macro
'
'
If (Range("A1:A20").Value = "a" And IsEmpty(Range("C5").Value) = True) Then
MsgBox "A is Missing"
End If
End Sub
Along with this code, I've also tried:
If (Range("A1:A20").Find("a", LookIn:=xlValues, MatchCase:=True) And IsEmpty(Range("C5").Value) = True) Then
If (InStr(1, Range("A1:A20"), "a") And IsEmpty(Range("C5").Value) = True) Then
If (CountIf("A1:A20", "a") > 0) And IsEmpty(Range("C5").Value) = True) Then
None of these have worked.
You can use a while loop to check if in range, there is a single letter "a" on it
Sub Null_Test()
Dim i As Integer
i = 1
Do While Cells(i, 1).Cells <> ""
If InStr(Cells(i, 1).Value, "a") And Range("C5").Value = "" Then
MsgBox "A is Missing"
i = i + 1
Else
i = i + 1
End If
Loop
End Sub
if you only want it to run through range("A1:A20") you can use a for loop
Sub Null_Test()
Dim i As Integer
For i = 1 To 20
If InStr(Cells(i, 1).Value, "a") And Range("C5").Value = "" Then
MsgBox "A is Missing"
End If
Next
End Sub
I'm trying to clean up raw data exported from an online database.
There can be up to five columns. If all cells in a row have a value of 0, I want to delete that row.
When the user exports the data, they can choose to exclude columns, and the columns can be in any order.
For example, if the data contains only two of the possible five columns, I want to check just those two for 0s.
Could do a a big loop looking at every row and seeing if all 5 columns in that row are blank
Sub test()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("sheetname")
Dim LastRow As Integer
LastRow = sh.UsedRange.Rows.Count - 1
For i = 1 To LastRow
If (sh.Cells(i, 1).Value = "" And sh.Cells(i, 2).Value = "" And sh.Cells(i, 3).Value = "" And _
sh.Cells(i, 4).Value = "" And sh.Cells(i, 5).Value = "") Then
sh.Cells(i, 1).EntireRow.Delete
i = i - 1
Dim newLastRow As Integer
newLastRow = sh.UsedRange.Rows.Count - 1
If i = newLastRow Then
Exit For
End If
End If
Next i
MsgBox ("Done")
End Sub
#kyle campbell, thank you for your input! It didn't quite get me there, but it did get my wheels turning. Here is the solution I came up with, if anyone's curious:
I set a variable to represent the column number for each of the 5 possible columns using Range.Find. If the Find came up with nothing, I set the variable to 49, since the maximum number of columns this report can have is 48.
Then I did a nested If to test if the value in each cell was either 0 or null (because if the column number is 49, there won't be any data there). If all Ifs were true, I deleted the row. I also added a counter and message box, just to make sure this worked.
Sub DeleteRows()
Dim O As Long
Dim E As Long
Dim H As Long
Dim B As Long
Dim P As Long
lRow = Range("A1").CurrentRegion.Rows.Count
If Range("1:1").Find("SUM(OBLIGATIONS)") Is Nothing Then
O = 49
Else
O = Range("1:1").Find("SUM(OBLIGATIONS)").Column
End If
If Range("1:1").Find("SUM(EXPENDITURES)") Is Nothing Then
E = 49
Else
E = Range("1:1").Find("SUM(EXPENDITURES)").Column
End If
If Range("1:1").Find("SUM(HOURS)") Is Nothing Then
H = 49
Else
H = Range("1:1").Find("SUM(HOURS)").Column
End If
If Range("1:1").Find("SUM(BUDGET_RESOURCES)") Is Nothing Then
B = 49
Else
B = Range("1:1").Find("SUM(BUDGET_RESOURCES)").Column
End If
If Range("1:1").Find("SUM(PRIOR_YEAR_RECOVERY)") Is Nothing Then
P = 49
Else
P = Range("1:1").Find("SUM(PRIOR_YEAR_RECOVERY)").Column
End If
Dim j As Integer
j = 0
For i = lRow To 2 Step -1
If Cells(i, O) = 0 Or Cells(i, O) = "" Then
If Cells(i, E) = 0 Or Cells(i, E) = "" Then
If Cells(i, H) = 0 Or Cells(i, H) = "" Then
If Cells(i, B) = 0 Or Cells(i, B) = "" Then
If Cells(i, P) = 0 Or Cells(i, P) = "" Then
Rows(i).Delete
j = j + 1
End If
End If
End If
End If
End If
Next i
MsgBox "Macro complete, " & j & " lines deleted."
End Sub
I have a Userform with a listbox for which I am using conditional logic to determine output values to the sheet of selected or non-selected items in the listbox. The issue is that when the Textbox (Tbl_AliasName) is blank, the code executes this:
ElseIf .Selected(k) = True And Tbl_AliasName = vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Trim(Cells(2, 1).Value2) & "." & .Column(1, k)
But if Tbl_AliasName is not blank then the code does nothing, but it is supposed to do this:
ElseIf .Selected(k) = True And Tbl_AliasName <> vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Tbl_AliasName & "." & .Column(1, k)
I have used several variations of If statements, and non of which have worked.
Below is My Code:
Option Explicit
Public Tbl_AliasName As String
Tbl_AliasName = Trim(UserForm_Finder.txtConcat.Value)
Private Sub BtnConcat_Click()
Dim k As Long, lstbxRow As Long, LR As Long
lstbxRow = 1
'****************
'This if statement works perfectly
If (Cells(2, 1).Value2 = vbNullString Or Cells(2, 2).Value2 = vbNullString) _
And Tbl_AliasName = vbNullString Then
MsgBox "You must Search for a Table or Column first.", _
vbExclamation, "Error Encountered"
Exit Sub
ElseIf (UserForm_Finder.ListBx_TblsCols.ListCount = 0 And Tbl_AliasName <> vbNullString) Then
MsgBox "You must Search for a Table or Column first.", _
vbExclamation, "Error Encountered"
'(Cells(2, 1).Value2 = vbNullString Or Cells(2, 2).Value2 = vbNullString) And _
Exit Sub
End If
With UserForm_Finder.ListBx_TblsCols
For k = 0 To .ListCount - 1
'****************
This is where the problems begin
If .Selected(k) = False Then
MsgBox "You must Select 1 or more items from the list box.", _
vbExclamation, "Error Encountered"
Exit Sub
ElseIf .Selected(k) = True And Tbl_AliasName <> vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Tbl_AliasName & "." & .Column(1, k)
ElseIf .Selected(k) = True And Tbl_AliasName = vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Trim(Cells(2, 1).Value2) & "." & .Column(1, k)
End If
Next k
End With
End Sub
My goal is to do the following:
If a Textbox (Tbl_AliasName) is not blank and the user has selected one or more items in the listbox (ListBx_TbleCols) then concatenate the Tbl_AliasName to the selected items in the listbox
If Tbl_AliasName is blank, then use the value in Cells(2,1) to concatenate to the selected Items in the list box.
I have tried the following additions:
Dim LstBxItemSelected As Boolean
'This was placed in the for loop
LstBxItemSelected = True
'this was placed outside the for loop
If LstBxItemSelected = False Then
MsgBox "You must Select 1 or more items from the list box.", _
vbExclamation, "Error Encountered"
Exit Sub
End If
Is there a better way to tell if items are selected, because I feel that the way I have it structured in my loop, the code will throw the error if everything isn't selected? Thank you in advance for any ideas, answers, or suggestions!
Note: The Listbox is populated by the click of another button on the userform which calls the following sub:
Sub FillLstBxCols()
Dim ListBx_Target As MSForms.ListBox
Dim rngSource As Range
Dim LR As Long
If Cells(2, 1).Value2 <> vbNullString Then
LR = Worksheets("New TRAX").Cells(Rows.Count, 2).End(xlUp).Row
'Set reference to the range of data to be filled
Set rngSource = Worksheets("New Trax").Range("A" & 2 & ":" & "B" & LR)
'Fill the listbox
Set ListBx_Target = UserForm_Finder.ListBx_TblsCols
With ListBx_Target
.RowSource = rngSource.Address
End With
End If
End Sub
Hard to say without sample data and expected results, but I think this is what you're looking for:
Private Sub btnConcat_Click()
Dim ws As Worksheet
Dim bSelected As Boolean
Dim sConcat As String
Dim i As Long, lRowIndex As Long
Set ws = ActiveWorkbook.Sheets("New TRAX")
lRowIndex = 1
bSelected = False
sConcat = Trim(Me.txtConcat.Text)
If Len(sConcat) = 0 Then sConcat = Trim(ws.Cells(2, "A").Value)
If Len(sConcat) = 0 Then
MsgBox "You must Search for a Table or Column first.", vbExclamation, "Error Encountered"
Exit Sub
End If
For i = 0 To Me.ListBx_TblsCols.ListCount - 1
If Me.ListBx_TblsCols.Selected(i) Then
If bSelected = False Then
bSelected = True
ws.Range("C2", ws.Cells(ws.Rows.Count, "C")).Clear 'clear previous concat results (delete this line if not needed)
End If
lRowIndex = lRowIndex + 1
ws.Cells(lRowIndex, "C").Value = sConcat & "." & Me.ListBx_TblsCols.List(i)
End If
Next i
If bSelected = False Then MsgBox "Must select at least one item from the list"
End Sub
I am trying to create a message box that will give the user the option to continue or stop if their search comes up with more than 1000 results. I have the message box made, but I don't know how to code the vbYes and the vbNo to either continue on with the code (vbYes) or to end the script (vbNO).
Here is my code.
Sub FindOne()
Range("B19:J5000") = ""
Application.ScreenUpdating = False
Dim k As Integer, EndPasteLoopa As Integer, searchColumn As Integer, searchAllCount As Integer
Dim myText As String
Dim totalValues As Long
Dim nextCell As Range
Dim searchAllCheck As Boolean
k = ThisWorkbook.Worksheets.Count
myText = ComboBox1.Value
Set nextCell = Range("B20")
If myText = "" Then
MsgBox "No Address Found"
Exit Sub
End If
Select Case ComboBox2.Value
Case "SEARCH ALL"
searchAllCheck = True
Case "EQUIPMENT NUMBER"
searchColumn = 1
Case "EQUIPMENT DESCRIPTION"
searchColumn = 3
Case "DUPONT NUMBER"
searchColumn = 6
Case "SAP NUMBER"
searchColumn = 7
Case "SSI NUMBER"
searchColumn = 8
Case "PART DESCRIPTION"
searchColumn = 9
Case ""
MsgBox "Please select a value for what you are searching by."
End Select
For I = 2 To k
totalValues = Sheets(I).Cells(Rows.Count, "A").End(xlUp).Row
ReDim AddressArray(totalValues) As String
If searchAllCheck Then
searchAllCount = 5
searchColumn = 1
Else
searchAllCount = 0
End If
For qwerty = 0 To searchAllCount
If searchAllCount Then
Select Case qwerty
Case "1"
searchColumn = 3
Case "2"
searchColumn = 6
Case "3"
searchColumn = 7
Case "4"
searchColumn = 8
Case "5"
searchColumn = 9
End Select
End If
For j = 0 To totalValues
AddressArray(j) = Sheets(I).Cells(j + 1, searchColumn).Value
Next j
If totalValues > 1000 Then
Results = MsgBox("Your Search has Returned Over 1000 Results. Continuing Could Cause Excel to Slow Down or Crash. Do you Wish to Continue?", vbYesNo + vbExclamation, "Warning")
End If
If Results = vbNo Then
End
End If
If Results = vbYes Then
For j = 0 To totalValues
If InStr(1, AddressArray(j), myText) > 0 Then
EndPasteLoop = 1
If (Sheets(I).Cells(j + 2, searchColumn).Value = "") Then EndPasteLoop = Sheets(I).Cells(j + 1, searchColumn).End(xlDown).Row - j - 1
For r = 1 To EndPasteLoop
Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(I).Range("A" & j + r, "I" & j + r).Value
Set nextCell = nextCell.Offset(1, 0)
Next r
End If
Next j
Else
End
End If
Next qwerty
Next I
Debug.Print tc
Application.ScreenUpdating = True
End Sub
If I understood your problem, you have to compare the "Results" variable if is vbYes or vbNo.
Below a little and simple example.
If MsgBox("Continue?", vbYesNo,"Confirmation") = vbYes Then
'code if yes
Else
'End
End If
Hope that helps. ;)
vbYes is a constant, a member of an enum called VbMsgBoxResult that defines a bunch of related constants, including vbYes and vbNo.
If vbYes Then
That's like saying
If 42 Then
You have a constant expression that evaluates to a Long integer, and an If statement works with a Boolean expression that evaluates to a Boolean value (True/False).
You need to compare vbYes to something to get that Boolean expression.
If Results = vbYes Then
I need to delete columns in a spreadsheet using a loop instead of manually hardcoding those columns in. However all I get is a very unhelpful Next without For error.
Sub test()
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Dim colNum2 As Integer
colNum2 = 1
For x = 1 To 32
If Range("A1").Value = "Order No." Then
Next colNum
ElseIf Range("B1").Value = "Line No." Then
Next colNum
ElseIf Range("C1").Value = "Order Qty." Then
Next x
ElseIf Range("D1").Value = "PO" Then
Next x
ElseIf Range("E1").Value = "Sched Date" Then
Next x
ElseIf Range("F1").Value = "Sched MFG Line" Then
Next x
ElseIf Range("G1").Value = "Item No." Then
Next x
ElseIf Range("H1").Value = "Item Width" Then
Next x
ElseIf Range("I1").Value = "Item Height" Then
Next x
ElseIf Range("J1").Value = "SL Color" Then
Next x
ElseIf Range("K1").Value = "Frame Option" Then
Next x
End If
'Checks if the cell matches a specific string required by the sorter
'if TRUE should skip through to the next increment of colNum
Columns(colNum2).EntireColumn.Delete
'uses the current number of colNum to delete the current column number
colNum2 = colNum2 + 1
Next x
'increments colNum by one
'Iterates next through the loop
I feel like this would work with say Java or Python so I'm really irritated VBA won't let me do this.
Can someone please explain what is going wrong with this code?
Just use var = var + 1 instead of Next. Next ends the For cycle.
Also you don't need to repeat the variable name on the Next line since it's already in the For line. (For i = 0 To 5 ... Next)
For x = 1 To 32
If Range("A1").Value = "Order No." Then
colNum = colNum +1
ElseIf Range("C1").Value = "Order Qty." Then
x = x + 1
End If
Next
Keep in mind what Scott Cranner said, the Next will also do x=x+1, so if you only want to increment once per cycle, use the Do While cycle instead
x = 1
Do While x <= 32
If Range("A1").Value = "Order No." Then
colNum = colNum +1
ElseIf Range("C1").Value = "Order Qty." Then
x = x + 1
End If
Loop
It seems to me that you want to delete all of the columns that do not match 'a specific string required by the sorter'. In that case, you could loop through all of the columns header labels, deleting the ones that do not match or use a custom left-to-right sort to put all of the non-matching columns to the right and delete then en masse.
Method 1 - Delete non-matching columns
Sub test1()
Dim c As Long, vCOLs As Variant
vCOLs = Array("Order No.", "Line No.", "Order Qty.", "PO", _
"Sched Date", "Sched MFG Line", "Item No.", _
"Item Width", "Item Height", "SL Color", "Frame Option")
With Application
'.ScreenUpdating = False
'.EnableEvents = False
End With
With Worksheets("sheet1")
With .Cells(1, 1).CurrentRegion
'delete from right-to-left or risk missing one
For c = .Columns.Count To 1 Step -1
If IsError(Application.Match(.Cells(1, c).Value2, vCOLs, 0)) Then
.Columns(c).EntireColumn.Delete
End If
Next c
End With
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Method 2 - Custom sort, then offset and delete
Sub test2()
Dim vCOLs As Variant
vCOLs = Array("Order No.", "Line No.", "Order Qty.", "PO", _
"Sched Date", "Sched MFG Line", "Item No.", _
"Item Width", "Item Height", "SL Color", "Frame Option")
With Application
'.ScreenUpdating = False
'.EnableEvents = False
.AddCustomList ListArray:=vCOLs
End With
With Worksheets("sheet1")
With .Cells(1, 1).CurrentRegion
'custom sort to bring the important fields to the left
.Cells.Sort Key1:=.Rows(1), Order1:=xlAscending, _
Orientation:=xlLeftToRight, Header:=xlNo, _
OrderCustom:=Application.GetCustomListNum(vCOLs)
'offset and delete the unwanted columns
With .Offset(0, Application.Match(vCOLs(UBound(vCOLs)), .Rows(1), 0))
.EntireColumn.Delete
End With
End With
End With
With Application
.DeleteCustomList .GetCustomListNum(vCOLs)
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
With either method you are simply listing the columns you want to keep and removing the rest.
There is a twist between .Cells.Sort.SortFields.Add and .Cells.Sort that usually generates some confusion. The .SortFields.Add method uses a CustomOrder:= parameter and the Range.Sort method uses a OrderCustom:= parameter. The two are most definitely NOT the same but often get used interchangeably with disastrous results.
I suspect you are trying to delete columns based on their text values in row 1. This will give you what you want, just put all the text references that you want to delete in the CASE statement.
Option Explicit
Sub DeleteColumns()
Dim colNum As Integer
colNum = 1
Do While Range(alphaCon(colNum) & 1).Value <> ""
Select Case Range(alphaCon(colNum) & 1).Value
Case "ColumnIDontWant", "AnotherColumnIDontWant"
Columns(colNum).EntireColumn.Delete
End Select
colNum = colNum + 1
Loop
End Sub
Public Function alphaCon(aNumber As Integer) As String
' Fixed version 27/10/2011
Dim letterArray As String
Dim iterations As Integer
letterArray = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If aNumber <= 26 Then
alphaCon = (Mid$(letterArray, aNumber, 1))
Else
If aNumber Mod 26 = 0 Then
iterations = Int(aNumber / 26)
alphaCon = (Mid$(letterArray, iterations - 1, 1)) & (Mid$(letterArray, 26, 1))
Else
'we deliberately round down using 'Int' as anything with decimal places is not a full iteration.
iterations = Int(aNumber / 26)
alphaCon = (Mid$(letterArray, iterations, 1)) & (Mid$(letterArray, (aNumber - (26 * iterations)), 1))
End If
End If
End Function