Inserting Blank Rows in Excel VBA - excel

Hey I have been writing some code to add a part ID to a spreadsheet off of a user form in Excel VBA. I have been reading through different documentation and can not figure out why no matter what type of method of inserting a row I try it inserts a row with a repeating value instead of a blank one. If anyone knows how to specify blank, other than writing the whole row to blank and then writing my numbers I want after, that would be appreciated.
I have tried both the following lines to add a row
Cells (x+1 ,column).EntireRow.Insert Shift:= xlDown
ws1.Rows(x+1).Insert Shift:=xlDown
This is the function it is used in:
Public Sub Add(IDRange As Range)
SearchCell = Cells(x, IDRange.Column)
Cells(x, IDRange.Column).Select
Do
If SearchCell = PartID Then
MsgBox " this Company Already uses this part"
Exit Sub
ElseIf x <> StopRow Then
x = x + 1
SearchCell = Cells(x, IDRange.Column)
End If
Loop While x <> StopRow And SearchCell <> PartID
Cells(x + 1, IDRange.Column).EntireRow.Insert Shift:=xlDown
Cells(x, IDRange.Column).Value = PartID
MsgBox PartID & " has been added to Adress " & Cells(x, IDRange.Column).Address
Cells(x, IDRange.Column).Select
End Sub
Bellow is the function that calls the Add Function and where I belive it may be getting the company name from
Private Sub AddPart_Click()
AddPartCounter = 0
Company = UserForm1.CompanyBox.Value
PartID = UserForm1.PartBox.Value
If Company = "" Then
MsgBox " Please put in the company you would like the part to go under"
ElseIf PartID = "" Then
MsgBox " Please put in the Part you would like entered"
ElseIf UserForm1.Studs.Value = False And UserForm1.Spreaders.Value = False And UserForm1.Blocks.Value = False And UserForm1.Imma.Value = False Then
MsgBox "Please select the type of part you are trying to add"
Else
Dim CurrentCell
Set CurrentCell = Cells.Find(What:=Company, LookAt:=xlWhole)
If CurrentCell Is Nothing Then
MsgBox " Company Not Found "
Exit Sub
End If
x = CurrentCell.Row
Do
Set CurrentCell = CurrentCell.Offset(1, 0)
Loop While CurrentCell.Offset(1, 0) = "" And Not CurrentCell Is Nothing And CurrentCell.Offset(1, 0).Row <> thisvar.Row + 1
StopRow = CurrentCell.Row
'If they are trying to add a nut
If UserForm1.Imma.Value = True Then
Call Add(Nut_ID_Rng)
'IF they are trying to add a stud
ElseIf UserForm1.Studs.Value = True Then
Call Add(Stud_ID_Rng)
'If they are trying to add a block
ElseIf UserForm1.Blocks.Value = True Then
Call Add(Block_ID_Rng)
'If they are trying to add a spreader
ElseIf UserForm1.Spreaders.Value = True Then
Call Add(Spreader_ID_Rng)
End If
End If
AddPartCounter = 1
End Sub
I know that the repeating pattern is coming from the insert line through debugging but I can not figure out why I have tried changing variables to numbers and it still did the same thing. This what it looks like with the repeating values.
enter image description here

The problem is that you most likely have a value still stored in your clipboard when you execute the Macro. To fix that, simply add this line of dode before running the insert line:
Applcation.CutCopyMode = False
That will clear your clipboard and allow the inserted rows to be blank.

Related

Excel Listbox not Populating Correctly

I have been following a tutorial and playing with developing Fully Automated User Data Entry Form.
The Video I followed PSB:
https://www.youtube.com/watch?v=P53T6oxgUVA&ab_channel=TheDataLabs
After having downloaded his files and gone through the code step by step, I still get a yellow highlight over the particular section of the ELSE statement on the Sub Clear()? Additionally my Listbox does not update correctly it replaces the previous entry with the next entry saved.
Please view the code below
Sub Clear()
Dim iRow As Long
iRow = [Counta(Room Access 2!A:A)] '''Identify Last Row as per tutorial''
With Frm_Room_Access_2
.Surname_Txtbx.Value = ""
.Rank_Cmbobx.Value = ""
.Section_Txtbx.Value = ""
.Extention_Txtbx.Value = ""
.Service_Number_Txtbx.Value = ""
.Due_Time_Txtbx.Value = ""
.OpBtn_Time_as_Now.Value = False
.SerialNo_Txtbx.Value = ""
If iRow > 1 Then
.List_Database.RowSource = "Room Access 2!A2:G" & iRow
Else
.List_Database.RowSource = "Room Access 2!A2:G" '''' Keeps Highlighting Error ''''
End If
End With
End Sub
Sub Submit()
Dim sh As Worksheet
Dim iRow As Long
Set sh = ThisWorkbook.Sheets("Room Access 2")
If Frm_Room_Access_2.SerialNo_Txtbx.Value = "" Then
iRow = [Counta(Room Access 2!A:A)] + 1
Else
iRow = Frm_Room_Access_2.SerialNo_Txtbx.Value
End If
With sh
.Cells(iRow, 1) = iRow - 1
.Cells(iRow, 2) = Frm_Room_Access_2.Surname_Txtbx.Value
.Cells(iRow, 3) = Frm_Room_Access_2.Service_Number_Txtbx.Value
.Cells(iRow, 4) = Frm_Room_Access_2.Rank_Cmbobx.Value
.Cells(iRow, 5) = Frm_Room_Access_2.Section_Txtbx.Value
.Cells(iRow, 6) = Frm_Room_Access_2.Extention_Txtbx.Value
.Cells(iRow, 7) = IIf(Frm_Room_Access_2.OpBtn_Time_as_Now.Value = True And Frm_Room_Access_2.Due_Time_Txtbx.Value = "", Now(), Frm_Room_Access_2.Due_Time_Txtbx.Value)
End With
End Sub
The Issues that I want to resolve is firstly why is my list box not adding another entry under the first entry, it simply replaces the first entry upon saving. Do I require another method for this?
Secondly why is the code Highlighting that the Else Statement is incorrect despite following the tutorial and replicating the code correctly to my particular needs.
Any advice will be greatly appreciated.
The last cell with text in a column can be found with
Range("B" & 1).End(xlDown).Offset(1, 0).Select
The Offset(1, 0) selects the cell below in order for you to copy data to it.
To select a worksheet use:
Worksheets("Room Access 2").Select
No underlines are needed.

How would I use an If Statement from a userform where if the cell matches another cell it would add the results to a specific field / row?

The majority of my code is working correctly however, when I move onto validation form the userform to excel it isn't working correctly. I am using a form that allows the user to enter in a job number in column AA and Quantity in Column AC. I am keeping a list of jobs in column A. When the user uses the button it will auto fill columns AA thru AD I am looking for after this is done it will check to see if the job number exists in column A and if it does then in the same row in Column D it would add the quantity that was just entered. In the background I have a piece of code that will auto calculate and increase in column D
Private Sub CommandButton1_Click()
whichSheet = PartNoTxtBox.Value
If whichSheet = "" Then
MsgBox "You didn't specify a Part Number"
Exit Sub
End If
Worksheets(whichSheet).Activate
If Me.PartNoTxtBox = "" Then GoTo MoreInfo
If Me.AddJobNoTxtBox = "" Then GoTo MoreInfo
If Me.AddShipperNoTxtBox = "" Then GoTo MoreInfo
If Me.AddQtyTxtBox = "" Then GoTo MoreInfo
If Me.AddDate = "" Then GoTo MoreInfo
''LastRow
eRow = Cells(Rows.Count, "AA").End(xlUp).Offset(1, 27).Row
Cells(eRow, 27) = AddJobNoTxtBox.Text
Cells(eRow, 28) = AddShipperNoTxtBox.Text
Cells(eRow, 29) = AddQtyTxtBox.Text
Cells(eRow, 30) = AddDate.Text
If AddJobNoTxtBox.Value = Cells(eRow, 1) Then
Cells(eRow, 4) = AddQtyTxtBox.Text
End If
Unload UserForm1
Exit Sub
MoreInfo:
MsgBox "More information required."
End Sub
The issue is located at the If AddJobNoTxtBox.Value=Cells...
any direction would be helpful.

Cell Formatting

Short question regarding excel formatting.
I am currently working on a userform-based protocol tool. The userform basically consists of two input windows, one which loads the exisitng bullet points and one to add new points.
Additionally, I would like to have the date in bold font added to each bullet point. I implemented that by searching for the position in the string where the date occurs (via instrrev) and then changing the font for the next 10 characters to bold font.
Now it works perfectly fine when creating a new bullet point, but it always messes up when I add an additional point to an existing topic or when I change an old bullet point (Then the whole text is bold). Anyone knows why this happens?
Private Sub Fertig_Click()
Dim neu As String
Dim i As Integer
neu = Date & ": " & mitschrieb_neu.Value
'No Changes
If mitschrieb_neu.Value = "" And mitschrieb_alt.Value = ActiveCell.Value Then
Unload Me
Exit Sub
End If
'First bullet point
If mitschrieb_neu.Value <> "" And ActiveCell.Value = "" Then
ActiveCell.Value = neu
i = InStrRev(ActiveCell.Value, Date)
ActiveCell.Characters(i, 10).Font.Bold = True
Unload Me
Exit Sub
End If
'New bullet point
If mitschrieb_neu.Value <> "" And ActiveCell.Value <> "" Then
ActiveCell.Value = ActiveCell.Value & Chr(10) & neu
i = InStrRev(ActiveCell.Value, Date)
ActiveCell.Characters(i, 10).Font.Bold = True
Unload Me
Exit Sub
End If
'Changed an old bullet point
If mitschrieb_neu.Value = "" And mitschrieb_alt.Value <> ActiveCell.Value Then
ActiveCell.Value = mitschrieb_alt.Value
Unload Me
Exit Sub
End If
End Sub
Once you execute this:
ActiveCell.Value = ActiveCell.Value & Chr(10) & neu
The Bold setting for the cell becomes uniform -- it erases any knowledge of substring formatting.
So the solution is to parse the complete value in a loop, and identify all the dates and make them bold.
At the same time I would suggest some way to reduce the duplication of code and merge all different cases (first bullet, not first bullet, modification only) into one generic way:
Private Sub Fertig_Click()
Dim neu As String
Dim i As Integer
'No Changes
If mitschrieb_neu.Value = "" And mitschrieb_alt.Value = ActiveCell.Value Then
Unload Me
Exit Sub
End If
' Join the old value with the new value and put a linefeed
' in between only if both are not empty.
' Also insert the date before the new value, if it is not empty
ActiveCell.Value = mitschrieb_alt.Value _
& IIf(mitschrieb_alt.Value <> "" And mitschrieb_neu.Value <> "", Chr(10), "") _
& IIf(mitschrieb_neu.Value <> "", Date & ": " & mitschrieb_neu.Value, "")
ActiveCell.Font.Bold = False ' start with removing all bold
' Search for all colons and put prededing date in bold (if it is a date)
i = InStr(ActiveCell.Value, ": ")
Do While i
' Make sure to only put in bold when it is a date, otherwise skip this ":"
If i > 10 And IsDate(Mid(ActiveCell.Value, i - 10, 10)) Then
ActiveCell.Characters(i - 10, 10).Font.Bold = True
End If
' find next
i = InStr(i + 1, ActiveCell.Value, ": ")
Loop
Unload Me
End Sub

Find if two non-consecutive values are the same vba

I have one column of data with either "UP", "DOWN" or "" as values. I am trying to write code that states that for all rows, if the first cell is "UP" then check the next rows until I come to either "DOWN" or "UP", i.e. if the next row has a "" then check the next row until I come to either a "DOWN" or "UP".
I am very new to VBA, and have tried various options, but seem to only be able to bring back where there are consecutive "UP"s or "DOWNS" rather than where there is an "UP", a number of rows of "" and then another "UP".
This is my code:
Range("z1:z250").Select
Selection.ClearContents
For Row = 2 To 250
If Range("Y" & Row).Value = "UP" Then
For sRow = 3 To 250
If Range("Y" & Row + 1).Value = "UP" Then
Range("Z" & Row) = "MT-UP"
ElseIf Range("Y" & Row + 1).Value = "" Then
End If
Next
End If
Next
End Sub
I have tried to add code such as For Each c in Range (“Y3”:”Y250”) but this doesn't make it find the next UP, and makes it very slow. I have also tried GoTo next cell (although seem to understand this is frowned upon!) but this doesn't work either. Any help appreciated.
Not 100% clear if this is what you want but take a look...
Instead of nested loops I used a flag to mark when a second consecutive "UP" was found before encountering a "DOWN". From your description it seems there's no need to check for empty cells ("").
Sub MTTest()
Dim Row As Long
Dim MTRow As Long
Dim MTFlag As Boolean
Range("Z1:Z250").ClearContents
For Row = 2 To 250
If Range("Y" & Row).Value = "UP" Then
If MTFlag = True Then
Range("Z" & MTRow) = "MT-UP"
MTFlag = Flase
Else
MTFlag = True
MTRow = Row
End If
Else
If Range("Y" & Row).Value = "DOWN" Then MTFlag = False
End If
Next
End Sub

VBA - How do i output data to corresponding cell by checking name and emptycell?

Good Day,
really need some help here, im bad at VBA.
Had created a spreadsheet and recorded a macro to record checkin of staff. However, im having difficulties checking out with the corresponding users based on the name.
Could anyone help me out over here?
Thanks. Had attached the spreadsheet for your ref.
http://www.etechnopia.com/vish/Book1ss.xlsm
After much googling, This is what i did based on mikes solution
Dim name As String
Dim id As Integer
Dim checkin As Date
Dim checkout As Date
name = Range("d6").Value
id = Range("d7").Value
checkin = Now
Range("d10") = checkin
Help anyone? im my very best here.
firstly I recommend to use range names for the important cells of your sheet
D6 EmpName
D7 EmpNo
D10 ClockInTime
D11 ClockOutTime
H5..H11 DataTable
This will enable you to reference them by name instead of hardcoding their addresses (bad bad hardcoding :-/ )
Secondly, your [Button] must serve a dual purpose ... it has to decide if a user is clocked in or out and do different things
a hi-level META code, executed at pressing [Button4] could be
if user clocked in
write current time into ClockOutTime ' remark: this may be superfluous
find DataTable record (EmpName, ClockInTime)
write ClockOutTime into record (EmpName, ClockInTime)
erase EmpName, EmpID, ClockInTime, ClockOutTime
else
write current time into ClockInTime
find first blank record in DataTable
write EmpName, EmpID, ClockInTime into DataTable record
endif
How to decide if a user is clocked in? If many users are using the same sheet at the same time (meaning 5 emps go there, write in their names and clock in) you need to examine DataTable for the first record of EmpNane without a ClockOutTime - if found he/she is in and needs to be clocked out.
more later ...
OK ... sorry was interrupted by Lady Gaga concerto in Vienna/AT
so here's a full code for the button
Sub ButtonPressed()
Dim DB As Range, Idx As Integer
Set DB = Range("DataTable")
If Range("EmpName") = "" Or Range("EmpNo") = "" Then
MsgBox "Enter your name and ID before pressing the button", vbCritical + vbOKOnly, "missing input"
Exit Sub
End If
Idx = UserClockedIn()
If Idx <> 0 Then
DB(Idx, 4) = Date + Time()
DB(Idx, 5).Formula = "=" & DB(Idx, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & "-" & DB(Idx, 3).Address(RowAbsolute:=False, ColumnAbsolute:=False)
DB(Idx, 5).NumberFormat = "[hh]:mm"
Range("EmpName") = ""
Range("EmpNo") = ""
Else
Idx = 2
Do While DB(Idx, 1) <> ""
Idx = Idx + 1
Loop
DB(Idx, 1) = Range("EmpName")
DB(Idx, 2) = Range("EmpNo")
DB(Idx, 3) = Date + Time()
End If
End Sub
Private Function UserClockedIn() As Integer
Dim DB As Range, Idx As Integer
Set DB = Range("DataTable")
UserClockedIn = 0
Idx = 2
Do While DB(Idx, 1) <> ""
If DB(Idx, 1) = Range("EmpName") And DB(Idx, 2) = Range("EmpNo") And DB(Idx, 4) = "" Then
UserClockedIn = Idx
Exit Function
End If
Idx = Idx + 1
Loop
End Function
#user502908: I have not documented it because I want you to find out exactly what it does and by that have a quick start into Excel-VBA :-) It doesn't do too much and there are some basic thechniques you will apply again & again if you go into VBA ... try to populate ranges "ClockInTime" and "ClockOutTime" :-)))
Book1ssNew.xlsm
have fun
I tried another simpler method which i could cope with
Sub yes()
Dim findId As Integer
Dim FirstAddress As String
Dim FindString As Integer
Dim Rng As Range
FindString = Range("d7").Value
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("F1:J100")
Set Rng = .find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
FirstAddress = Rng.Address
Rng.Offset(0, 2).Value = Now()
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Search entire spreadsheet given id, when id found, to indicate dynamically the checkin timing.

Resources