What this is supposed to do: When a user enters a value for ttxt on a userform and clicks on the button 'add' it will first check if the value is blank, and if it is it will enter the input value of the user-- if its not empty, it will go 2 columns over to the right and enter the value there. This will keep adding the value to the right once every button click. I'm not sure how to go about this.
'Starts on column G1
Range("G1").End(xlUp).Offset(2, 0).Select
Do Until ActiveCell.Value = ttxt.Value
If ActiveCell.Value = "" Then
ActiveCell.Value = Me.ttxt
Else
'Offsets to the right 2 columns to enter another value if previous value is
'not empty.
ActiveCell.Offset(0, 2).Value = Me.ttxt
End If
Loop
Me.ttxt = ""
See below
Private Sub addbtn_Click()
Worksheets("Sheet1").Activate
Dim r As Range
Set t = Range("F1").End(xlUp).Offset(2, 0)
Set r = Range("G1").End(xlUp).Offset(2, 0)
Do Until r.Value = "" And t.Value = ""
Set r = r.Offset(, 2) 'Moves over 2 columns
Set t = t.Offset(, 2) 'Moves over 2 columns
Loop
'Inputs values
r.Value = Me.ttxt
t.Value = Me.atxt & ", " & Me.xtxt
With Me.ListBox1
.AddItem
.List(i, 0) = Me.ttxt
.List(0, i) = Me.atxt & ", " & Me.xtxt
i = i + 1
End With
'Clears out userform
Me.ttxt = ""
Me.atxt = ""
Me.xtxt = ""
End Sub
So this is the entire code for the add click button. So this code as you know adds the user input values into the columns like its supposed to. I have a listbox on the userform as well. Whenever a person adds the values to the sheet I want the values to be placed into the listbox as well. The current code adds the first value, and any value after that it just replaces the first value in the listbox. Hopefully you understand what I'm trying to say.
I want the values to keep being added down the list whenever I add them as it does on the sheet.
Sub AlternateColumnsEmpty()
'Starts on column G1
Dim r As Range
Set r = Range("G3")
If r.Value = "" Then
r.Value = Me.ttxt
Else
Cells(r.Row, Columns.Count).End(xlToLeft).Offset(, 2).Value = Me.ttxt
End If
Me.ttxt = ""
End Sub
Sub AlternateColumnsHaveData()
'Starts on column G1
Dim r As Range
Set r = Range("G3")
Do Until r.Value = ""
Set r = r.Offset(, 2)
Loop
r.Value = Me.ttxt
Me.ttxt = ""
End Sub
Related
I am trying to create a For and Do while loop in VBA. I want that when the value 'X' is entered in column A and if column W is equal to "T", all the rows below (column A) should be checked "X" until the next value "T" in column W.
My script does not work, only the row below is filled with "X" and the file closes (bug!)
Here is the complete code
Sub Chaine()
For Each Cell In Range("A2:A3558")
If UCase(Cell.Value) = "X" And Cells(Target.Row, 23) = "T" Then
Do While Cell.Offset(0, 23) <> "T"
Cell.Offset(1, 0).Value = "X"
Loop
End If
Next Cell
End Sub
Try this:
Sub Chaine()
Dim c As Range, vW, flag As Boolean
For Each c In ActiveSheet.Range("A2:A3558").Cells
vW = UCase(c.EntireRow.Columns("W").value)
If UCase(c.value) = "X" And vW = "T" Then
flag = True 'insert "X" beginning on next row...
Else
If vW = "T" Then flag = False 'stop adding "X"
If flag Then c.value = "X"
End If
Next c
End Sub
Your Do While loop has to be problem as it doesn't change and will continue to check the same thing. It's unclear what you want to happen, but consider something like this as it moves to the right until you've exceeded the usedrange.
Sub Chaine()
Dim cell As Range
For Each cell In Range("A2:A3558").Cells
If UCase(cell.Value) = "X" And Cells(Target.Row, 23) = "T" Then
Do While cell.Offset(0, 23) <> "T"
Set cell = cell.Offset(0, 1)
'not sure what this is supposed to do...?
'cell.Offset(1, 0).Value = "X"
If cell.Column > cell.Worksheet.UsedRange.Cells(1, cell.Worksheet.UsedRange.Columns.Count).Column Then
MsgBox "This has gone too far left..."
Stop
End If
Loop
End If
Next cell
End Sub
I just went off your description in the question. Your code is not doing what you want and it's not really how you would do this in my opinion. I figured I would put an answer that does what you ask but, keep it simple.
I'm guessing Target in the code refers to an event.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo SomethingBadHappened
'Checks if you are in the A column from the target cell that
'was changed and checks if only X was typed.
If (Target.Column = 1 And UCase(Target) = "X") Then
Dim colToCheck_Index As Integer
colToCheck_Index = 23 'W Column
Dim colToCheck_Value As String
Dim curRow_Index As Integer
curRow_Index = Target.Cells.Row
'Checks if the column we are checking has only a T as the value.
If (UCase(ActiveSheet.Cells(curRow_Index, colToCheck_Index).Value) = "T") Then
Application.EnableEvents = False
Do
'Set the proper cell to X
Range("A" & curRow_Index).Value = "X"
curRow_Index = curRow_Index + 1
'Set the checking value to the next row and check it in the
'while loop if it doesn't equal only T
colToCheck_Value = ActiveSheet.Cells(curRow_Index, colToCheck_Index)
'Set the last row to X on the A column.
Loop While UCase(colToCheck_Value) <> "T"
Range("A" & curRow_Index).Value = "X"
Application.EnableEvents = True
End If
Exit Sub
SomethingBadHappened:
Application.EnableEvents = True
End If
End Sub
I am looking for a way to shorten my code to input data from a form of 10 entries.
This is my userform with one RMA number (applies to all 10 PN), one customer name, 10 part numbers, and 10 serial numbers that go with each part number.
This is how I want data transferred to the worksheet.
The part number textboxes are named TB#.
The serial number textboxes are named SNTB#.
This is the code I have for the first entry. I was thinking of adding code to say "TB"&"i" and "SNTB"&"i", but I don't know where to place that statement or how to start it.
Private Sub EnterButton_Click()
'this assigns receiving data to first columns of log Sheet
If TB1.Value = "" Then
Else
Worksheets("RM Tracker").Activate
Dim lastrow
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastrow = lastrow + 1
Cells(lastrow, 1) = RMATB.Value
Cells(lastrow, 2) = CustCB.Value
Cells(lastrow, 3) = TB1.Value
Cells(lastrow, 4) = SNTB1.Value
Cells(lastrow, 5) = ReceiveTB.Value
ActiveCell.Offset(1, 0).Select
End If
ActiveWorkbook.Save
Call resetform
End Sub
Sub resetform()
RMATB.Value = ""
CustCB.Value = ""
TB1.Value = ""
SNTB1.Value = ""
ReceiveTB = ""
'sets focus on that first textbox again
RecForm.RMATB.SetFocus
End Sub
You can incorporate a for loop where "i" represents the row you are working with. When you are appending data you need to put that reference within the loop so the new row is recalculated.
Private Sub EnterButton_Click()
'this assigns receiving data to first columns of log Sheet
If TB1.Value = "" Then
Else
Worksheets("RM Tracker").Activate
dim i as long
For i = 1 To 10
Dim lastrow as long ' should put a data type with dim statements
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastrow = lastrow + 1
Cells(lastrow, 1) = Userform1.Controls("RMATB" & i).Value ' change userform name to fit your need
Cells(lastrow, 2) = Userform1.Controls("CustCB" & i).Value
Cells(lastrow, 3) = Userform1.Controls("TB1" & i).Value
Cells(lastrow, 4) = Userform1.Controls("SNTB1" & i).Value
Cells(lastrow, 5) = Userform1.Controls("ReceiveTB" & i).Value
Next i
End If
ActiveWorkbook.Save
Call resetform
End Sub
Sub resetform()
RMATB.Value = ""
CustCB.Value = ""
TB1.Value = ""
SNTB1.Value = ""
ReceiveTB = ""
'sets focus on that first textbox again
RecForm.RMATB.SetFocus
I have a ComboBox that has a Value of "ConcretePad". I also have a Range named "ConcretePad".
i am trying to Select Range based off of ComboBox Value.
***Private Sub CatagoryCB_Change()
Dim rg As String
rg = (CatagoryCB.Value)
Worksheets("Data").Select
If (CatagoryCB.Value = "") Then
GoTo Line2
ElseIf (CatagoryCB.Value <> "") Then
Range(rg).Select
Line2:
End If
End Sub***
Trying to make rg represent the Value of CatagoryCB.Value, which i did but when i put it in the cell reference for range i get an error
You're probably looking for something like this (provided you're using a ListFillRange):
Private Sub CatagoryCB_Change()
If (CatagoryCB.ListIndex <> -1) Then
Worksheets("Data").Select
Range(CatagoryCB.ListFillRange).Cells(CatagoryCB.ListIndex + 1, 1).Select
End If
End Sub
This just grabs the ListFillRange, navigates to the ListIndex which is in sync with it and selects it.
CatagoryCB.ListIndex will return the index of the selected item in the list.
If a value that isn't in the list is selected, it will return -1.
So, for example, if I set my ListFillRange to A1:A3 and select the first option, I will do a Range("A1:A3").Cells(1, 1).Select because the ListIndex of the selected item is 0 (first item) and .Cells(0 + 1, 1) = .Cells(1, 1).
If you're populating the ComboBox manually, you'd need to give it the range you want to link to or perform a find operation.
It's hard to tell from your code.
I figured it out. My (CatagoryCB.Value) was not equal to my Range Name. This is the code i was able to produce to add a part to my datasheet on my current worksheet. This also adds the new row to my range
Dim i As String
Dim c As Integer
Dim g As Integer
i = CatagoryCB.Value
Worksheets("Data").Select
If i = "" Then
GoTo Line2
ElseIf i <> "" Then
Range(i).Select
c = Range(i).Count
Range(i).Activate
ActiveCell.Offset(c, 0).Select
g = ActiveCell.Row
Worksheets("Data").Rows(g).Insert
Range(i).Resize(c + 1).Name = i
Cells(g, 1).FormulaR1C1 = Cells(g - 1, 1).FormulaR1C1
Cells(g, 3) = (Part_NumberTB.Value)
Cells(g, 4) = (VendorCB.Value)
Cells(g, 5) = (DescriptionTB.Value)
Cells(g, 7) = (CostTB.Value)
Cells(g, 8) = (CostTB.Value * 1.35)
Cells(g, 9) = (CostTB.Value * 1.35)
Cells(g, 10).FormulaR1C1 = Cells(g - 1, 10).FormulaR1C1
Cells(g, 11).FormulaR1C1 = Cells(g - 1, 11).FormulaR1C1
Line2:
End If
I have 3 sheets that need to check if they have same value. All value on column B6 until last row should be same in Sheets MM, PP and CO. If there's difference value, the different value should be on highlight (the color is red).
But, my syntax didn't run. The syntax just can read if there's an empty column in range. This is my syntax.. Not including highlight. First, i tried to place the difference value to the other sheets. But, failed. Thank you.
Sub MatchValue()
Dim x As Integer
Dim y As Integer
Dim z As Integer
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
x = ActiveWorkbook.Worksheets("MM").Range("B6:B" & LastRowB).Cells.SpecialCells(xlCellTypeConstants).Count
y = ActiveWorkbook.Worksheets("PP").Range("B6:B" & LastRowB).Cells.SpecialCells(xlCellTypeConstants).Count
z = ActiveWorkbook.Worksheets("CO").Range("B6:B" & LastRowB).Cells.SpecialCells(xlCellTypeConstants).Count
If x <> y Then
MsgBox "MM <> PP", vbCritical, "Error Report"
End If
If y <> z Then
MsgBox "PP <> CO", vbCritical, "Error Report"
End If
If z <> x Then
MsgBox "CO <> MM", vbCritical, "Error Report"
End If
SheetMM = "MM"
DataColumnMM = "B6"
SheetPP = "PP"
DataColumnPP = "B6"
SheetCO = "CO"
DataColumnCO = "B6"
SheetUnmatched = "Data Unmatched"
DataColumnUnmatched = "A1"
DataRowMM = Range(DataColumnMM).Row
DataColMM = Range(DataColumnMM).Column
DataRowPP = Range(DataColumnPP).Row
DataColPP = Range(DataColumnPP).Column
DataRowCo = Range(DataColumnCO).Row
DataColCo = Range(DataColumnCO).Column
DataRowUnmatched = Range(DataColumnUnmatched).Row
DataColUnmatched = Range(DataColumnUnmatched).Column
LastDataMM = Sheets(SheetMM).Cells(Rows.Count, DataColMM).End(xlUp).Row
LastDataPP = Sheets(SheetPP).Cells(Rows.Count, DataColPP).End(xlUp).Row
LastDataCO = Sheets(SheetCO).Cells(Rows.Count, DataColCo).End(xlUp).Row
LastDataUnmathced = Sheets(SheetUnmatched).Cells(Rows.Count, DataColUnmatched).End(xlUp).Row
For counter = DataRowMM To LastDataRowMM
If WorksheetFunction.CountIf(LastDataPP, counter) = 0 Then
LastDataUnmathced.Offset(1) = counter
End If
Next
For counter = DataRowMM To LastDataRowMM
If WorksheetFunction.CountIf(LastDataCO, counter) = 0 Then
LastDataUnmathced.Offset(1) = counter
End If
Next
For counter = DataRowPP To LastDataRowPP
If WorksheetFunction.CountIf(LastDataCO, counter) = 0 Then
LastDataUnmathced.Offset(1) = counter
End If
Next
End Sub
Based on the information you've provided, you want to:
Check three tables across three sheets in the ActiveWorkbook
Check to see if the same number of constants exists in the table ranges
Highlight cells red where the values between the three sheets aren't the same
I've simplified the code in order to achieve these targets
Sub MatchValue()
Dim Range1 As Range, Range2 As Range, Range3 As Range
With ActiveWorkbook
With .Sheets("MM") 'First Sheet Name
Set Range1 = .Range("B6") 'Address of first row on First Sheet
Set Range1 = .Range(Range1, .Cells(.Rows.Count, Range1.Column).End(xlUp))
End With
With .Sheets("PP") 'Second Sheet Name
Set Range2 = .Range("B6") 'Address of first row on second Sheet
Set Range2 = .Range(Range2, .Cells(.Rows.Count, Range2.Column).End(xlUp))
End With
With .Sheets("CO") 'Third Sheet Name
Set Range3 = .Range("B6") 'Address of first row on third Sheet
Set Range3 = .Range(Range3, .Cells(.Rows.Count, Range3.Column).End(xlUp))
End With
End With
'Delete this part if you don't want to remove the existing fill (might be handy)
Range1.Interior.Pattern = xlNone
Range2.Interior.Pattern = xlNone
Range3.Interior.Pattern = xlNone
'Checks to see if the same number of constants exist within the test ranges
If Range1.SpecialCells(xlCellTypeConstants).Count <> _
Range2.SpecialCells(xlCellTypeConstants).Count Then
MsgBox "Range 1 and Range 2 constant count doesn't match", vbCritical, "Error Report"
ElseIf Range2.SpecialCells(xlCellTypeConstants).Count <> _
Range3.SpecialCells(xlCellTypeConstants).Count Then
MsgBox "Range 1 and Range 2 constant count doesn't match", vbCritical, "Error Report"
End If
Dim Temp1 As Variant, Temp2 As Variant, Temp3 As Variant, x As Long
'Checks to see if all the values entered are the same, if not, fills them red
Temp1 = Range1.Value
Temp2 = Range2.Value
Temp3 = Range3.Value
For x = 1 To UBound(Temp1, 1)
If Temp1(x, 1) <> Temp2(x, 1) Or _
Temp2(x, 1) <> Temp3(x, 1) Then
Range1.Cells(x, 1).Interior.Color = RGB(255, 0, 0)
Range2.Cells(x, 1).Interior.Color = RGB(255, 0, 0)
Range3.Cells(x, 1).Interior.Color = RGB(255, 0, 0)
End If
Next x
End Sub
I Have 10 columns in an Excel table, and I want to delete the rows where the first 7 cell is empty.
I've tried to do it this way:
Sheet1.Range("Table4[variable1, variable2, variable3, variable4, variable5, variable6, variable7]").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
but It doesn't work. Am I have to use nested for loop for rows and columns?
You can loop trough each row directly, and check if the first 7 cells of that row in your table are empty. If true, delete them.
Dim MyTable As ListObject
Dim i As Long
Set MyTable = ActiveSheet.ListObjects("Table4")
With MyTable.DataBodyRange
For i = .Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountBlank(.Range(Cells(i, 1), Cells(i, 7))) = 7 Then .Rows(i).Delete
Next i
End With
The good point about this way is that if your table changes address, it still will work. You would only need to update if you want to check a different name of cells (seven rght now) or if the condition (7 first cells empty) changes.
Broadly speaking yes. Loop down the rows you want to check,
For rowcounter = 1 to 10 'whatever rows you want
use the test
If Application.WorksheetFunction.CountA("A" & rowcounter & ":G" & rowcounter) = 0 Then
(I assume first 7 columns meant A to G), and then
Rows(rowcounter).Delete
You don't need multiple loops. A single loop with the use of the IsEmpty() function should work:
Option Explicit
Sub Test()
Dim i As Long
For i = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row To 1 Step -1
If IsEmpty(Sheet1.Cells(i,1)) And IsEmpty(Sheet1.Cells(i,2)) And IsEmpty(Sheet1.Cells(1,3)) And _
IsEmpty(Sheet1.Cells(i,4)) And IsEmpty(Sheet1.Cells(i,5)) And _
IsEmpty(Sheet1.Cells(i,6)) And IsEmpty(Sheet1.Cells(i,7)) Then
Sheet1.Rows(i).Delete
End If
Next i
End Sub
I guess that this simple snippet, full of unnecessary procedures, can help you:
Sub NotTested()
' Choose below the rows range
first_row = 2
last_row = 4242
For r = last_row To first_row Step -1
' Checking below each column (from row r) value
a_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 1).Value2
b_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 2).Value2
c_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 3).Value2
d_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 4).Value2
e_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 5).Value2
f_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 6).Value2
g_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 7).Value2
' Comparing if the columns are actually empty
If a_value = "" And b_value = "" And c_value = "" And d_value = "" And e_value = "" And f_value = "" And g_value = "" Then
ThisWorkbook.Sheets("Sheet1").Cells(r, 1).EntireRow.Delete
End If
Next r
End Sub
Here's a simple solution that actually counts the number of rows in a table then deletes if the first 7 columns are blank.
Sub deleteEmptyRows()
Set tbl = ActiveSheet.ListObjects("Table4")
For I = 1 To tbl.Range.Rows.Count
If WorksheetFunction.CountA(Range("A" & I & ":" & "G" & I)) = 0 Then
Sheets("Sheet1").Rows(I).EntireRow.Delete
End If
Next I
End Sub