Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

adapting code to insert column(DATE) to put price under them

0

Hello,

I have this code to add price from textbox1 to column C after matching BRAND in combobox1 with BRAND in column C .

but sometimes the brands will change the prices, so I want adding  new column based on DATE after column C , create header is DATE   and put the price  under date , as to others BRANDS so should be zero as hyphen .

shouldn't repeat add column for DATE( today), just one time and just replace the prices if I change on userform .

Private Sub CommandButton1_Click()
 Dim ws As Worksheet, LR As Long, qtyP As Double, qtyT As Double, f As Range
  If ComboBox1.Value <> "" Then
    Set ws = Sheets("PRICES")
    LR = ws.Cells(Rows.Count, 2).End(3).Row
    Set f = ws.Range("B:B").Find(ComboBox1.Value, , xlValues, xlWhole, , , False)
With f.Offset(, 1)
.Value = Val(TextBox1.Value)
End With
End If
End Sub
Answer
Discuss

Answers

0
Selected Answer

Hi Leap

Try this (in the FIRST attached revised file) and follow the comments, noting that I changed column D to be 28 May 2024 and removed some usused variable declarations.:

Private Sub CommandButton1_Click()

    Dim ws As Worksheet, LR As Long, f As Range
    Dim LC As Long ' for last column

    If ComboBox1.Value <> "" Then
        Set ws = Sheets("PRICES")
        ' get last row
        LR = ws.Cells(Rows.Count, 2).End(3).Row
        ' search in used range
        Set f = ws.Range("B2:B" & LR).Find(ComboBox1.Value, , xlValues, xlWhole, , , False)
        ' quit if not found
        If f Is Nothing Then Exit Sub
        ' get last column in row 1
        LC = ws.Cells(1, Columns.Count).End(xlToLeft).Column
        ' if todoay's date not last column...
        If Cells(1, LC) <> Date Then
            ' ... copy last and add tate
            Cells(1, LC).EntireColumn.Copy Cells(1, LC + 1).EntireColumn
            LC = LC + 1
            Cells(1, LC).Value = Date
            ' put dash in all entries
            Range(Cells(2, LC), Cells(LR, LC)).Value = "-"
        End If

        With f.Offset(, 1)
            'write old price to last colum
            Cells(.Row, LC).Value = .Value
            'write new value to C
            .Value = Val(TextBox1.Value)
        End With
    End If

End Sub

Note that it writes the OLD price into today's column and the new price into column C.

You might want to add Else code for the case where a new entry is made in the textbox (and there's no match from the Find)- that should go after the last "End With".

Revision #1 29 May 2024

Following the user's comments below, the SECOND attached file has the revised code below and writes new prices only to column D (filling it with dashes if it does not have today's date as a heading):

Private Sub CommandButton1_Click()

    Dim ws As Worksheet, LR As Long, f As Range

    If ComboBox1.Value <> "" Then
        Set ws = Sheets("PRICES")
        ' get last row
        LR = ws.Cells(Rows.Count, 2).End(3).Row
        ' search in used range
        Set f = ws.Range("B2:B" & LR).Find(ComboBox1.Value, , xlValues, xlWhole, , , False)
        ' quit if not found
        If f Is Nothing Then Exit Sub
        ' if not today's date column D...
        If Cells(1, 4) <> Date Then
            ' write today's date
            Cells(1, 4) = Date
            ' ... put dash in all entries
            Range(Cells(2, 4), Cells(LR, 4)).Value = "-"
        End If
        'write new value to D
        f.Offset(, 2).Value = Val(TextBox1.Value)

    End If

End Sub

Once again, D1 was changed to 28 May 2024 (yesterday) for the purposes of demonstration.

Revision #2 30 May 2024

In the THIRD attached file, my original solution has the last With block replaced by the lines in bol so that new columns are added for new dates, with the new prices written ONLY to the new date column:

Private Sub CommandButton1_Click()

    Dim ws As Worksheet, LR As Long, f As Range
    Dim LC As Long ' for last column

    If ComboBox1.Value <> "" Then
        Set ws = Sheets("PRICES")
        ' get last row
        LR = ws.Cells(Rows.Count, 2).End(3).Row
        ' search in used range
        Set f = ws.Range("B2:B" & LR).Find(ComboBox1.Value, , xlValues, xlWhole, , , False)
        ' quit if not found
        If f Is Nothing Then Exit Sub
        ' get last column in row 1
        LC = ws.Cells(1, Columns.Count).End(xlToLeft).Column
        ' if todoay's date not last column...
        If Cells(1, LC) <> Date Then
            ' ... copy last and add tate
            Cells(1, LC).EntireColumn.Copy Cells(1, LC + 1).EntireColumn
            LC = LC + 1
            Cells(1, LC).Value = Date
            ' put dash in all entries
            Range(Cells(2, LC), Cells(LR, LC)).Value = "-"
        End If

        'write new price to last column
        Cells(f.Row, LC).Value = CDbl(TextBox1.Value)
    End If

End Sub

Revision #3 30 May 2024

Corrected third file attached.

Hope this fixes your problem. If so, please remember to mark this Answer as Selected

Discuss

Discussion

Hi John,
thanks ,but I don't the new price in column C . I want  every new price should be under date(today) . I don't move old price to date(today).
the new price  should be under date accurately .
leap (rep: 48) May 29, '24 at 3:35 pm
Leap. I'm confused. You said "... as to others BRANDS so should be zero as hyphen" so if ONLY each new price is in the date column, is that okay?

Do you want only one date column (or several, to see the history of price changes)?

Your explanation in the original question is ambiguous unfortunately so I think I'll probably leave this to Willie since it's getting late here. 
John_Ru (rep: 6537) May 29, '24 at 3:48 pm
Please see revised comment above. 
John_Ru (rep: 6537) May 29, '24 at 3:55 pm
as to others BRANDS so should be zero as hyphen" so if ONLY each new price is in the date column, is that okay?
yes it's ok.
Do you want only one date column 
yes just one column for DATE(TODAY) even if I change prices on userform then will replace without insert new column for date(today) has already inserted.
look everything is ok except one thing . the problem in column C  you should ignore it totally, why new price add to column C , not under 29/05/2024 after insert ne column based on DATE today?
to be honest you are really colse to solve my question.
thanks in advanced
leap (rep: 48) May 29, '24 at 4:11 pm
Leap. Not sure I understand. I added new price to C so there is one place to look for current prices (and you don't need to update price before the next day, e.g. when you close the workbook). 

Please respond- I may look later tonight and revise my answer. 
John_Ru (rep: 6537) May 29, '24 at 4:38 pm
jut new price  should add under date(today) after insert new column after column C  when the column DATE(today) is existed then will just change values  based on userform without repeat insert column date(today) again.
your way doesn't give the new price in right a day .
I have another project to match prices in specific days, that's why I want every new price should be under date ( today).
leap (rep: 48) May 29, '24 at 4:50 pm
Leap.

Please see Revision #1 29 May 2024 to my Answer, plus SECOND file.
John_Ru (rep: 6537) May 29, '24 at 5:25 pm
I'm  afraid  the things become different completely.
your code will replace  new date with old date , shouldn't do that .
example : when add new column D (29/05/2024) after column C , but tommorow  when add new column should be in E(30/05/2024) and so on.
leap (rep: 48) May 29, '24 at 5:36 pm
Leap. That's very annoying since I purposefully asked you if you wanted a single column or several to track the history.

If you want several columns, just use the first file but change the last With block with :
            'write new price to last colum
            Cells(.Row, LC).Value= CDbl(TextBox1.Value)
   
    End If
 
End Sub


I won't be doing anymore on this today. 
John_Ru (rep: 6537) May 29, '24 at 5:53 pm
I won't be doing anymore on this today. 
OK
just inform you about your suggestion works but not completely 
when insert add new column and fill under it also will change in column C at the same time.
I think the problem from this line
 With f.Offset(, 1)
leap (rep: 48) May 29, '24 at 6:08 pm
Leap

I told you abve to REMOVE that With block. I've done that (and corrected my suggestion) in Revision #2 30 May 2024 to my Answer, plus THIRD file.
John_Ru (rep: 6537) May 30, '24 at 2:29 am
I told you abve to REMOVE that With block.
I misread , sorry!
the third file doesn't seem to be corrected.
anyway thanks very much for your time and help.

leap (rep: 48) May 30, '24 at 3:56 am

Leap

You say "the third file doesn't seem to be corrected". I can't check for hours yet but maybe I made the correction:
       Cells(f.Row, LC).Value = CDbl(TextBox1.Value
is the original (first file) snd saved that 

If my file (or the cide correction) doesn't work, feel free ti Deselect my Answer and Select Willie's (since I see that works). 
John_Ru (rep: 6537) May 30, '24 at 9:16 am
If my file (or the cide correction) doesn't work, feel free ti Deselect my Answer and Select Willie's (since I see that works). 
 I followed your guiding to me and update original the code for suggestion line. and works greatly. just I said you the file is not correct until members take advantage from your solution ,that's it.
everything is ok  , thank you for your time.
leap (rep: 48) May 30, '24 at 11:46 am
Thanks Leap. I'll post a correct file later tonight (my time) hopefully. 
John_Ru (rep: 6537) May 30, '24 at 1:37 pm
Leap- you were right (file not corrected earlier) but have now attached the correct third file.
John_Ru (rep: 6537) May 30, '24 at 5:49 pm
Add to Discussion
0

Hello leap,

There were only a few small changes needed. (John submitted his solution while I was working on mine)

Added column "E" with title "Old Price". Changed columns "C" & "E" number formats to "0.00; -0.00; -; @". Added code to check that TextBox1 is not empty and a check to see if the price in TextBox1 is a change from the existing price. Cells "D1" & "E1" formatted as General.

If there is a new price then: 1) enter the date in Col "D";   2) enter the old price in Col "E";   3) enter new price in Col "C". (revised file attached)

Private Sub CommandButton1_Click()

' revised by WillieD24, May 2024

 Dim ws As Worksheet, LR As Long, qtyP As Double, qtyT As Double, f As Range

  If ComboBox1.Value <> "" Then
    Set ws = Sheets("PRICES")
    LR = ws.Cells(Rows.Count, 2).End(3).Row
        Set f = ws.Range("B:B").Find(ComboBox1.Value, , xlValues, xlWhole, , , False)

    With f.Offset(, 1)   ' Column "C"
        ' check if there is a price in TextBox1
         If TextBox1.Value = "" Then Exit Sub   ' no price entered
        ' check if there is a change in the price
        If f.Offset(, 1).Value = Val(TextBox1.Value) Then Exit Sub   ' no change in price

        ' price in column "C" not equal to price in TextBox1
        If .Value <> Val(TextBox1.Value) Then
            ' enter date in column  "D"
            f.Offset(, 2).Value = Date
            ' enter old price in column  "E"
            f.Offset(, 3).Value = f.Offset(, 1).Value
            ' enter new price in column  "C"
            f.Offset(, 1).Value = Val(TextBox1.Value)
        End If

    End With

End If

End Sub

Cheers   :-)

Update May 29 @ 5 PM

Hi leap,

If I understand correctly, you want the date entered in cell "D1" and the new price in column "D". Doing it this way you won't know the date each price changed. You will only know the date when the last price change happened – but not which price was changed. I have made this change in "RF Rev2.xlsm" attached.

Private Sub CommandButton1_Click()

' revised by WillieD24, May 2024

 Dim ws As Worksheet, LR As Long, qtyP As Double, qtyT As Double, f As Range

  If ComboBox1.Value <> "" Then
    Set ws = Sheets("PRICES")
    LR = ws.Cells(Rows.Count, 2).End(3).Row
        Set f = ws.Range("B:B").Find(ComboBox1.Value, , xlValues, xlWhole, , , False)

    With f.Offset(, 1)   ' Column "C"
        ' check if there is a price in TextBox1
        If TextBox1.Value = "" Then Exit Sub   ' no price entered
        ' check if there is a change in the price
        If f.Offset(, 1).Value = Val(TextBox1.Value) Then Exit Sub   ' no change in price

        ' price in column "C" not equal to price in TextBox1
        If .Value <> Val(TextBox1.Value) Then
            ' enter date in  "D1"
            Range("D1").Value = Date
            ' enter new price in column  "D"
            f.Offset(, 2).Value = Val(TextBox1.Value)
        End If

    End With

End If

End Sub

Cheers   :-)

Update May 29 @ 8:45 PM

Hi leap,

In this 3rd revision, when a new price is entered, and "today's date" is different than that of the last column, a new column is added with today's date at the top and the new price entered into this new column. The result, a separate column for each date a new price(s) was entered. File "RF Rev3.xlsm" is attached.

Private Sub CommandButton1_Click()

' revised by WillieD24, May 2024

 Dim ws As Worksheet, LR As Long, LC As Long, qtyP As Double, qtyT As Double, f As Range

  If ComboBox1.Value <> "" Then
    Set ws = Sheets("PRICES")
    LR = ws.Cells(Rows.Count, 2).End(3).Row
    LC = ws.Cells(1, Columns.Count).End(xlToLeft).Column
        Set f = ws.Range("B:B").Find(ComboBox1.Value, , xlValues, xlWhole, , , False)

    With f.Offset(, 1)   ' Column "C"
        ' check if there is a price in TextBox1
        If TextBox1.Value = "" Then Exit Sub   ' no price entered
        ' check if there is a change in the price
        If f.Offset(, 1).Value = Val(TextBox1.Value) Then Exit Sub   ' no change in price

        ' check if today's date is the same as date in last column
        If Cells(1, LC).Value <> Date Then
            ' date is different so create a new column for the current date
            ' format next column
            Columns(LC).Select
                Selection.Copy
                Columns(LC + 1).Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False
                Cells(1, LC + 1) = Date   ' enter current date for new column
                Range(Cells(2, LC + 1), Cells(LR, LC + 1)).Value = "0"
            Cells(1, LC + 1).Select
        End If

        ' price in column "C" not equal to price in TextBox1
        If f.Offset(, 1).Value <> Val(TextBox1.Value) And Cells(1, LC).Value <> Date Then
            ' enter new price in column of new date
            f.Offset(, LC - 1).Value = Val(TextBox1.Value)
            Else
            ' enter new price in column of current date
            f.Offset(, LC - 2).Value = Val(TextBox1.Value)
        End If

    End With

End If

End Sub

Hope this is what you were looking for. If my answer solves your problem then please mark my answer as selected.

Discuss

Discussion

Hi Willie,
thanks , but your data is different about way of showing.
doesn't seem to be arranged !
leap (rep: 48) May 29, '24 at 3:37 pm
thanks for updating, but unfortnately the code doesn't insert new column based on DATE(TODY)  just replace with D1 .
should insert D1,E1,F1..... so on but not repeatedly(mean when insert column DATE(TODAY)  and change by userform then just replace prices without insert DATE column again.
leap (rep: 48) May 29, '24 at 5:17 pm
unfortunately  this is no what I want . your code will insert DATE(TODAY) every time a day !
should add for only one time  , so when there is DATE column based on today no need to add again.
leap (rep: 48) May 29, '24 at 6:54 pm
@leap
Oooops, sorry about that, that is not what I intended. I found the typo and have fixed the code. Discard the previous "RF Rev3" - I have replaced it with the corrected version (of the same name)
Cheers   :-)
WillieD24 (rep: 637) May 29, '24 at 8:45 pm
it works as I want.
thank you so much.
leap (rep: 48) May 30, '24 at 3:59 am
@leap
Glad I could help. You say it works (Rev3) as you want but you selected John's answer. Do you prefer John's solution to mine?
WillieD24 (rep: 637) May 30, '24 at 8:42 am
@Leap - your call on which Answer you Select (see my latest comment under myAnswer)

@Willie - good work here but am I right in thinking that the Answer shows the code for your Rev1, not the "working" Rev3? (I'm mobile so can't check) 
John_Ru (rep: 6537) May 30, '24 at 9:18 am
@John
I have updated my answer to show the code for both Rev2 and Rev3.
WillieD24 (rep: 637) May 30, '24 at 11:23 am
Do you prefer John's solution to mine?
well
first John will answer before you 
second the code is slight lines unlike you
third you use selection propertise and I think will slowness code and many experts don't advice use it.
finally thank you.
leap (rep: 48) May 30, '24 at 11:57 am
@Willie - thanks for adding the Rev3 code to your Answer. Hopefully it will help other users later. 
John_Ru (rep: 6537) May 30, '24 at 1:41 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login