Do Until Selection.Value = "" Or _
(Selection.Value = theyear And Selection.Offset(0, 1).Value = themonth)
Selection.Offset(1, 0).Select
Loop
in this line of statement, the code is unable to check the condition with the or part ie; it does not check the condition in the bracket. Is it expected?
Try this:
Sub Test()
Dim sMonth As String
Dim iYear As Integer
sMonth = UCase(Trim(InputBox("Enter the first three alphabets of the month to append", "Month Initials")))
iYear = InputBox("Enter the year to which the month corresponds", "Year")
Do Until Selection.Value = "" Or _
(UCase(Trim(Selection.Value)) = sMonth And Selection.Offset(0, 1).Value = iYear)
Selection.Offset(1, 0).Select
Loop
End Sub
Your main mistake was to put a variable name between quotes.
However, I want to make note that this code may be quite sensible to bugs due to the fact that you allow the user to input any data without check.
But if it's for own use, this doesn't really matter.
Also note that .Select/Offset makes your code overall pretty rigid.
Related
Actually I want to check spacing and format of my Values Using VBA Macro. It is a dynamic string say 1 Count (Pack of 1) or 2 Count (Pack of 1), 20 g (Pack of 1) or 50 g (Pack of 2), 100 ml (Pack of 2) or 200 ml (Pack of 1). so the format remains the same but the integer alone changes in each cell. Also I wrote a code using instr function but it is not able to validate and give me the output. I want integer to be be defined as X and format should be the same.
I have mentioned the code below which I tried. I need some concept which can be helpful. I have attached the screenshot which needs to be validated. Thanks a lot.
Sub QualityCheck()
Dim LastColumn As Long
Dim X(1 To 20000) As Integer
ActiveSheet.Select
Range("A1").Select
LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Columns.Select
ActiveCell.Value = "Quality Error"
Range("A1").Select
Set P = Range("A$1:AD$1")
For Each cell In P
If cell.Value = "ASIN" Then cell.Offset(1, 0).Select
Next
Do While ActiveCell.Value <> ""
If ActiveCell.Offset(0, -2).Value = "DE" Then
If ActiveCell.Offset(0, 12).Value Like " Stück ( er Pack)" Then
ActiveCell.Offset(0, 26).Value = " Correct"
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Also I have tried like declaring a varaible like X = 1 to 1000 and concat "X&" Stuck ("&X&"er Pack")" but still it didne work. It would be helpful if I get the syntax to crack the concept. Thanks in advance.
From what I understood you need to modify this line:
If ActiveCell.Offset(0, 12).Value Like "*Stück (*er Pack)" Then
This modification goes like this:
Any char - then followed by "Stück (" then ANY CHARS - followed by "er Pack)"
Should work, let me know if it did!
Hope it helps.
I've written the code below but I can't get past a line where I want to insert a variable number of rows. The compiler screams that it needs a "list separator or )" where there is a colon. But I can't find other ways of writing this. Please, help! =)
So, the problematic line is denoted by two stars from each end. Just above it there is a commented line that I've also tried with no success.
Also, would you be so kind and explain me what I need the following commands for (they are also found in the problematic line):Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Finally, any suggestions of how I could improve the code, s.t., experienced programmers don't faint when they read it? =)
Huge thank you in advance,
Option Explicit
Dim ws As Worksheet
Dim Blatt1, Blatt2 As String
Dim Anfangsjahr1, Anfangsjahr2 As Integer
Dim reporting_Jahr1, reporting_Jahr2 As String
Public Sub Dreiecke()
For Each ws In Worksheets
If ws.Name Like "RVA_H*" Then
If IsEmpty(Blatt1) = False Then
Blatt2 = ws.Name
Anfangsjahr2 = ws.Range("A3").Value
reporting_Jahr2 = ws.Range("A1").Value
Else
Blatt1 = ws.Name
Anfangsjahr1 = ws.Cells(3, 1).Value
reporting_Jahr1 = ws.Cells(1, 1).Value
GoTo X
End If
Else: GoTo X
End If
If reporting_Jahr1 <> reporting_Jahr2 Then
MsgBox "Dreiecke von unterschiedlichen Jahren"
Exit Sub
ElseIf reporting_Jahr1 = reporting_Jahr2 Then
If Anfangsjahr1 < Anfangsjahr2 Then
'Sheets(Blatt2).Rows(3:3+Anfangsjahr2-Anfangsjahr1).EntireRow.Insert
**Worksheets(Blatt2).Rows(3: 3 + Anfangsjahr2 - Anfangsjahr1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove**
ElseIf Anfangsjahr1 > Anfangsjahr2 Then
Worksheets(Blatt1).Rows(3:3+Anfangsjahr1-Anfangsjahr2).Insert Shift:=xlDown
ElseIf Anfangsjahr1 = Anfangsjahr2 Then GoTo X
End If
End If
X: Next ws
End Sub
I don't follow exactly what you are trying to get to here but there are some syntax issues.
Not sure if this is what you want, but it fixes the syntax. Do you rally want
Worksheets(Blatt2).Rows("3:" & 3 + Anfangsjahr2 - Anfangsjahr1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
EDIT to expand on OP's question in the comments below
The double quotes are used to enclose a string. So normally when you are referencing rows you can say .Rows("3:9").Insert This is providing the rows you want to work with as a string.
In your case you wanted to dynamically provide last row so we have
our string "3:"
transition from string to variable &
and our variables and math 3 + Anfangsjahr2 - Anfangsjahr1
To make up .Rows("3:" & 3 + Anfangsjahr2 - Anfangsjahr1).Insert
You need to place the row number in double quotation marks and then concatenate the variables to the string using an ampersand:
Worksheets(Blatt2).Rows("3:" & 3 + Anfangsjahr2 - Anfangsjahr1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
I have a macro that inserts 2 columns on my current sheet and pastes information from another sheet.
I want to create 2 variables that are assigned to each column that would change the next time I run the macro to paste the information in the next two columns.
Columns("BO:BO").Select
Selection.Insert Shift:=xlToRight
Range("BO2").Select
ActiveCell.FormulaR1C1 = "Feb weekly-wk 2"
Range("BO19").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(Comparison!RC2,'Jan16 wk4'!R3C15:R34C24,9,FALSE)"
Range("BO19").Select
Selection.AutoFill Destination:=Range("BO19:BO47"), Type:=xlFillDefault
Range("BO19:BO47").Select
Columns("BP:BP").Select
Selection.Insert Shift:=xlToRight
Range("BP2").Select
Selection.Style = "20% - Accent6"
Range("BP2").Select
ActiveCell.FormulaR1C1 = "Diff"
Range("BP19").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
My idea is to set up a variable that I would replace my current "BO" and "BP" code with.
Dim X as String, Y as String
X = "BO"
y = "BP"
When I run the macro it would change the variable for this example "BO" to "BQ" and "BP" to "BR". Next time I run the macro would change the "BQ" to "BS" and "BR" to "BT".
I just cleaned your code a little:
Dim ColBO As Integer
Dim ColBP As Integer
Dim StrBO As String
Dim StrBP As String
StrBO = "BO"
StrBP = "BP"
ColBO = ActiveWorkbook.Range(StrBO & 1).Column 'instead of StrBO you could directly write ("BO" & 1)
ColBP = ActiveWorkbook.Range(StrBP & 1).Column 'Then you wouldnt need these two variables
Columns(ColBO).Insert Shift:=xlToRight
'Columns(ColBO).Select ' Trying to avoid selection but not sure if this works here...
'Selection.Insert Shift:=xlToRight
Range(1, ColBO).FormulaR1C1 = "Feb weekly-wk 2"
Range(19, ColBO).FormulaR1C1 = "=VLOOKUP(Comparison!RC2,'Jan16 wk4'!R3C15:R34C24,9,FALSE)"
Range(19, ColBO).AutoFill Destination:=Range("BO19:BO47"), Type:=xlFillDefault
Columns(ColBP).Insert Shift:=xlToRight 'Same here as above
Range(2, ColBP).Style = "20% - Accent6"
Range(2, ColBP).FormulaR1C1 = "Diff"
Range(19, ColBP).FormulaR1C1 = "=RC[-2]-RC[-1]"
For the future: If you can, try to avoid .Select/Selection/.Activate if possible. The code can mostly run without such commands and without activating a cell. ;)
If you are not actually writing BO/BP to the range you are transforming I would go with two ints, stored in a hidden sheet. Read/write each time you run the macro.
This is, in my opinion, the easier solution, other places to go would be global variables or storing it to a file.
If you want to use numeric variables you can change approach and use Cells instead of Range:
'You can use the rows below to know the column number
Range("BO1").Activate
ActiveCell.Value = ActiveCell.Column 'This way you get the column number into the cell
ColNum = ActiveCell.Column 'This way you get the column number into the variable
'So now you know that BO column number is 67 and you can use
Cells(1, 67) = "OK"
'Or, using variables:
RowNum = 1
ColNum = 67
Cells(RowNum, ColNum) = "You Got It!"
This makes you able to loop columns simply using a for ... next
If you need to loop from BO to BR you can use
For ColNum = 67 To 70
Cells(1, ColNum) = "OK"
Next ColNum
Hope it helps.
Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub
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.