So I am a student and my chef gave me the task of making the occupancy plan in excel more dynamic. Now I want to hide the columns if they dont belong to the specific month but it doesnt work like I want it. The days are now only shown up to the 28. of every month.
What is wrong here?
Sub montatslen()
Dim spaltenr As Integer
For spaltenr = 32 To 34
If Cells(3, 7).Value = Month(Cells(14, spaltenr).Value) Then
Columns(spaltenr).EntireColumn.Hidden = False
Else
Columns(spaltenr).EntireColumn.Hidden = True
End If
Next spaltenr
End Sub
I tried writing it this way and it seemed to work. It hides columns AF, AG and AH
Sub montatslen()
Dim spaltenr As Integer
For spaltenr = 32 To 34
columnLetter = Split(Cells(1, spaltenr).Address, "$")(1)
If Range("G3").Value = Month(Range(columnLetter & "14").Value) Then
Columns(spaltenr).EntireColumn.Hidden = False
Else
Columns(spaltenr).EntireColumn.Hidden = True
End If
Next spaltenr
End Sub
Related
I have written a code in VBA where a V-Lookup is done if a certain condition is met.
It works fine but now how can I do the same thing to the next row data values without the need to rewrite the code.
Sub starting_stock()
If Worksheets("out").Range("E2").Value = "" Then
Set ItemRef = Worksheets("out").Range("A2")
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D2").Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
End Sub
I want to do the same to D3 with values of E3, A3 without the need to rewrite the code every time.
This is an Stock Control System.
There are two sheets, One is called "Inventory" and the other is called "out".
Field in Inventory : ProductRef,Initial Stock, Stock Out(SUMIF for all Qty Out corresponding to a particular ProductRef), Final Stock.
Field in out : Product Ref, Starting Stock, Qty out, Remaining Stock, Date.
The aim here is to V-lookup the Final Stock from Inventory into Starting Stock if Qty Out is Null and as per the V-Lookup criteria of product Ref.
Remaining Out has a simple formula Starting Stock- Qty Out.
A normal formula cannot be used since any changes made in Qty will affect all previous entries with the same Product Ref.
Starting Stock should be as at date and remain as such.
All you need to do is wrap it in a For loop. See below:
Option Explicit
Sub starting_stock()
Dim i As Long
For i = 2 To 3
If Worksheets("out").Range("E" & i).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & i)
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D" & i).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
Next i
End Sub
Read more about For loops here: https://excelmacromastery.com/vba-for-loop/
I assume this is what you are looking for:
You want to select a cell in a column and run the code and it will use value of the A column on the same row to perform the vlookup and paste the value in D column with the same row?
In that case ActiveCell.row is probably what you need.
Sub starting_stock()
If Worksheets("out").Range("E" & ActiveCell.Row).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & ActiveCell.Row)
Set MyRange = Worksheets("Inventory").Range("A:G")
Worksheets("out").Range("D" & ActiveCell.Row).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 7, False)
End If
End Sub
I have found the following solution:
Sub Button_Click()
Dim i As Integer
i = 2
Do While Worksheets("out").Cells(i, 1).Value <> ""
If Worksheets("out").Range("E" & i).Value = "" Then
Set ItemRef = Worksheets("out").Range("A" & i)
Set MyRange = Worksheets("Current Inventory").Range("F:M")
Worksheets("out").Range("D" & i).Value = Application.WorksheetFunction.VLookup(ItemRef, MyRange, 8, False)
End If
i = i + 1
Loop
End Sub
A while loop with the condition of not empty ProductRef.
I am new to VBA and am trying to recode a program that already exists, with the intention of optimizing it and adding new features. The program takes a scanner input (though I am just manually entering in the numbers at the moment), which then records and categorizes the type of item that is taken out. It is then put in a log for reference later. Here is the first Userform that takes the scanned input:
Private Sub TextBox1_Change()
Dim barcode As Long, emptyRow As Long, testHold As Long
Set TempHold = Worksheets("TempHold")
If Application.WorksheetFunction.CountIf(TempHold.Range("D2:D25"), TextBox1.Value) = 1 Then
If Application.WorksheetFunction.CountIf(Range("B:B"), TextBox1.Value) = 0 Then
CartTypeMenu.Show
barcode = TextBox1.Value
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(emptyRow, 1).Value = Application.WorksheetFunction.VLookup(barcode, TempHold.Range("D2:E25"), 2, True)
Cells(emptyRow, 2).Value = barcode
Cells(emptyRow, 3).Value = Format(Now(), "mm/dd/yyyy hh:nn")
Cells(emptyRow, 4).Value = CartTypeMenu.ComboBox1.Value
TextBox1.Value = ""
Else
testHold = TextBox1.Value
Call boxTest(testHold)
End If
End If
End Sub
I have two tables in a separate sheet (TempHold) that have the scanned input corresponding to a number, and a number corresponding to a name. The row in the final log would basically be the number of the scanned input (as they are labeled by number), the scanned input, the time (which works properly), the type and then the name.
The problem I run into is when I search VLookup for the name to put into the next cell in the log row; getting the name from a number. It only looks for the name if it is actively in the log (it is cleared once tasks are completed). I have tried changing the numbers to strings, and vice versa, but I can't get it to work. Here is the problematic module:
Sub boxTest(testHold As Long)
Dim offsetValue As Long, myValue As Variant
Set ws = Worksheets("Log")
Set sheetLookup = Worksheets("TempHold")
offsetValue = Application.Match(testHold, ws.Range("B2:B8"), 0)
myValue = InputBox("Enter your number")
ws.Range("E" & offsetValue).Value = Application.WorksheetFunction.VLookup(myValue, sheetLookup.Range("A2:B9"), 1, True)
End Sub
VLookup keeps giving the error that it can't find the WorksheetFunction in this module.
On a Form I am using a ComboBox to search a text range and return that row value. The ScrollBox value is then set to the row value. My minimum row value is 5 and the max value is done by a row.count which happens to be 28. When I run the code the ScrollBar works fine until my value gets over 23, the scrollbar.value resets to 7 and starts all over again. Using the combobox to set the row value has the same problem as well and I am unable to search the whole text range.
Here is my code:
Private Sub ScrollBar1_Change()
g = ScrollBar1.Value
StrtComboBox.Value = Sheets("Main").Cells(g, 6).Value
Plyr1Lbl.Caption = Sheets("Main").Cells(g, 7).Value
Plyr2Lbl.Caption = Sheets("Main").Cells(g, 8).Value
Plyr3Lbl.Caption = Sheets("Main").Cells(g, 9).Value
Plyr4Lbl.Caption = Sheets("Main").Cells(g, 10).Value
TextBox9.Value = ScrollBar1.Value
TextBox10.Value = ScrollBar1.Max
End Sub
Private Sub StrtComboBox_Change()
Sheets("Main").Activate
LastHoleRow = Sheets("Main").Cells(Rows.Count, 6).End(xlUp).Row
Names.Add Name:="Holes", RefersTo:=Range("F5:F" & LastHoleRow)
Dim BoxValue As Range
With Range("Holes")
Set BoxValue = .Find(StrtComboBox.Value)
If BoxValue Is Nothing Then
Else
ScrollBar1.Value = BoxValue.Row
End If
End With
End Sub
You are searching for 8A and expecting to find it in F24, however it can be found earlier in F7 which has value 18A (since 8A can be found in the string 18A).
The fix should be simple. The .Find method has a .LookAt parameter which determines whether a complete match must be made. So just change
Set BoxValue = .Find(StrtComboBox.Value)
to this
Set BoxValue = .Find(What:=StrtComboBox.Value, LookAt:=xlWhole)
I had a piece of code commissioned earlier this week (cheaper to have an expert write it than for me to spend a week trying to!). However, when putting it use I've hit a bit of a snag.
The macro looks at a name on one excel worksheet, matches it to a list of names and associated ID numbers on a different worksheet, then inserts the ID on the first worksheet. This was all fine until I started using it on real data.
Here's some sample data (all of this information is in one cell...):
WARHOL*, Andy
PETO, John F
D3 GRECO, Emilio -20th C
HASELTINE, William Stanley
D3 DALI, Salvador
D3 SOSNO, Sacha
WEGMAN**, WILLIAM
One asterisk means it's a print, two a photograph, D3 a sculpture, and nothing a painting.
When I run the code with this data, it sees * as a wildcard, and so will always insert the ID of the first variation of the artist in the sheet. What I need is a way for the macro to not read it as a wildcard.
I did some research, and found that inserting ~ before * negates the wildcard properties. How would I make my code do this? I've discovered the main issue of having code written by someone else... You might not understand it!
Here is the code:
Public Sub match_data()
'ctrl+r
On Error GoTo errh
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim r1, r2, i, exc As Long
Dim fp As Range
Sheets("Data").Activate
r1 = Cells(Rows.Count, "B").End(xlUp).Row
r2 = Sheets("List").Cells(Sheets("List").Rows.Count, "B").End(xlUp).Row
'MsgBox r1 & r2
exc = 0
For i = 2 To r1
If Range("B" & i).Value <> "" Then
With Sheets("List").Range("B2:B" & r2)
Set fp = .Find(Range("B" & i).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not fp Is Nothing Then
Range("B" & i).Interior.Color = xlNone
Range("A" & i).Value = Sheets("List").Range("A" & fp.Row).Value
Else
Range("B" & i).Interior.Color = xlNone
Range("B" & i).Interior.Color = vbYellow
exc = exc + 1
End If
End With
End If
Next i
MsgBox "There are " & exc & " exceptions."
errh:
If Err.Number > 0 Then
MsgBox Err.Description
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Oh also, I would need to do this for the list of names and ID's wouldn't I? If so, that only needs doing once, so if you could give me a hint about that too, I'd be so grateful!
Thanks!
PS I know the system we are using at the moment absolutely sucks (definitely not 3rd form normalised!), but we are fast running out of time and money, and need to get our product up and running ASAP!
EDIT: To clarify, here is a pic of the spreadsheets I'm working with... Obviously in cells A14 and A15 I wanted the ID numbers 11 & 12 respectively
Here is one way to tell the stars from the planets:
Sub StaryNight()
Dim s As String, OneStar As String, TwoStar As String, ThreeStar As String
OneStar = "*"
TwoStar = "**"
ThreeStar = "***"
t = Range("A1").Text
ary = Split(t, ",")
s = ary(0)
If Right(s, 3) = ThreeStar Then
MsgBox "scupture"
Exit Sub
ElseIf Right(s, 2) = TwoStar Then
MsgBox "photograph"
Exit Sub
ElseIf Right(s, 1) = OneStar Then
MsgBox "print"
Exit Sub
End If
MsgBox "Painting"
End Sub
Okay, I have solved the problem! I had a play around with changing the variables in the Find and Replace box.
If I put ~* in both the find AND replace boxes, and uncheck Match entire cell contents, I can replace all of the * with ~* (really don't understand that but oh well!)
So I do this on the Data worksheet, but NOT on the List worksheet, run the macro as normal and the problem is solved!
Im having a little trouble with a code in excel vba.
What I want to do is that If any CELL within a RANGE on Sheet 1 is <= 2000 THEN hide a given row on Sheet 2. So it only takes 1 cell within a that range to be <= 2000 for the rows on the other sheet to be hidden. Kind of like a rotten apple spoils the bunch kind of thing.
Any help would be greatly appriciated. Thanks in Advance.
Edit: code i have that isnt working:
Edit2: code updated based on comments given, still no luck with it working.
Private Sub HideRows()
Sheets("Summary").Cells.EntireRow.Hidden = False
For Each cell In Sheets("Worksheet").Range("G9:P9")
If Abs(cell.Value) < 2000 Then
Sheets("Summary").Rows(11).EntireRow.Hidden = True
Sheets("Summary").Rows(23).EntireRow.Hidden = True
Sheets("Summary").Rows(43).EntireRow.Hidden = True
Sheets("Summary").Rows(54).EntireRow.Hidden = True
Sheets("Summary").Rows(78).EntireRow.Hidden = True
Sheets("Summary").Rows(90).EntireRow.Hidden = True
End If
Next
End Sub
The code does have the correct enders too such as End Select, Next, End Sub
-Matt
I'd do it this way:
Private Sub HideRows()
Worksheets("Summary").Cells.EntireRow.Hidden = False
For Each cell In Sheets("Worksheet").Range("G9:P9")
If Abs(cell) < 2000 Then
Worksheets("Summary").Range("A11,A22,A43,A54,A78,A90").EntireRow.Hidden = True
End If
Next
End Sub
It's best to use the Range object and reference non-contiguous cells as it makes it a single line.
You might Want to try and avoid Loops Something Like:
Sub NoLoopSample()
Dim lngLessThenSum As Long, lngGreaterThenSum As Long
Dim rngTestRange As Range
Set rngTestRange = Sheets("Worksheet").Range("G9:P9")
lngBetween2k4k = WorksheetFunction.SumIfs(rngTestRange, rngTestRange, ">=" & 2000, rngTestRange, "<" & 4000)
lngLessThenSum = WorksheetFunction.SumIf(rngTestRange, "<" & 2000)
If lngBetween2k4k > 0 Then
MsgBox "Atleast 1 Number Is Between 2000 And 4000"
End If
If lngLessThenSum > 0 Then
MsgBox "Atleast 1 Number Is Less then 2000"
Sheets("Summary").Range("11:11, 23:23, 43:43, 54:54, 78:78, 90:90").EntireRow.Hidden = True
End If
End Sub
Should do what you want and won't have to test EVERY Single cell in your range. There may be other functions or ways to do it but this was at the top of my head. Although on such a small range you shouldn't even notice the difference.
I also like to make as few changes to a worksheet from VBA as possible so in my example I hide all the rows you mention in one call rather then a call for each row.
Maybe it's about EntireRow property ..
Reference .. http://msdn.microsoft.com/en-us/library/office/ff836836.aspx
Since your code .. Rows("11").EntireRow.Hidden = True .. you have to make it sure that Row("11") is Range var ..
And to hide rows you may do Rows(11).Hidden = True
Sub try()
i = 1
While Sheet1.Cells(i, 1).Value <> ""
If Sheet1.Cells(i, 1).Value > 2000 Then
Sheet2.Rows(i).EntireRow.Hidden = True
End If
i = i + 1
Wend
End Sub
Straight to the point:
Range("a11,a22,a43,a54,a78,a90").EntireRow.Hidden = [sum((g9:p9>0)*(g9:p9<2001))]
You are concerned more with the minimum value only. I would rather use Excel's Min function for the work:
Sub HideRows()
Set InRng = Worksheets("Worksheet").Range("G9:P9") 'Input Range
Set OutRng = Worksheets("Summary").Range("A11,A22,A43,A54,A78,A90") 'Rows to be hidden
MinVal = Application.WorksheetFunction.Min(InRng) 'Invoking inbuilt function to get minimum value
If MinVal < 2000 Then
OutRng.EntireRow.Hidden = True
End If
End Sub