Enter description next to a number

P

Panoos64

Well-known Member
Joined
Mar 1, 2014
Messages
890
Hi all, i would like to write a vba so that where in col. "D" the number start from number 92 and in col. "F" is the category "BEVERGAE" should place on number's right side "APERITIF" and if in col. "F" and it start from 92 should place "SPICES" and so on.

In sch.1. are the original data and in sch.2. is the expected result.

Many thanks in advance

SCH.1.
1DATETYPEREF.1REF.2TR. NOCATEGORY
2
3
4
5
6
7

<colgroup><col style="mso-width-source:userset;mso-width-alt:1462;width:30pt" width="40"> <col style="width:48pt" width="64"> <col style="mso-width-source:userset;mso-width-alt:1682;width:35pt" width="46"> <col style="mso-width-source:userset;mso-width-alt:2048;width:42pt" width="56"> <col style="mso-width-source:userset;mso-width-alt:3913;width:80pt" width="107"> <col style="mso-width-source:userset;mso-width-alt:3328;width:68pt" width="91"> <col style="mso-width-source:userset;mso-width-alt:4534;width:93pt" width="124"> </colgroup><tbody>
[TD="width: 40"][/TD]
[TD="width: 64"]A[/TD]
[TD="width: 46"]B[/TD]
[TD="width: 56"]C[/TD]
[TD="width: 107"]D[/TD]
[TD="width: 91"]E[/TD]
[TD="width: 124"]F[/TD]

[TD="class: xl65"]03-02-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92145[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]BEVERAGE[/TD]

[TD="class: xl65"]10-05-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92505[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]BEVERAGE[/TD]

[TD="class: xl65"]10-05-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92800[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]BEVERAGE[/TD]

[TD="class: xl65"]10-05-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92905[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]FOOD[/TD]

[TD="class: xl65"]10-05-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92608[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]HOT BEVERAGE[/TD]

[TD="class: xl65"]10-05-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92700[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]HOT BEVERAGE
[/TD]

</tbody>



SCH.2.
1DATETYPEREF.1REF.2TR. NOCATEGORY
2
3
4
5
6
7

<colgroup><col style="mso-width-source:userset;mso-width-alt:1462;width:30pt" width="40"> <col style="width:48pt" width="64"> <col style="mso-width-source:userset;mso-width-alt:1682;width:35pt" width="46"> <col style="mso-width-source:userset;mso-width-alt:2048;width:42pt" width="56"> <col style="mso-width-source:userset;mso-width-alt:3913;width:80pt" width="107"> <col style="mso-width-source:userset;mso-width-alt:3328;width:68pt" width="91"> <col style="mso-width-source:userset;mso-width-alt:4534;width:93pt" width="124"> </colgroup><tbody>
[TD="width: 40"][/TD]
[TD="width: 64"]A[/TD]
[TD="width: 46"]B[/TD]
[TD="width: 56"]C[/TD]
[TD="width: 107"]D[/TD]
[TD="width: 91"]E[/TD]
[TD="width: 124"]F[/TD]

[TD="class: xl65"]03-02-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92145 APERITIF[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]BEVERAGE[/TD]

[TD="class: xl65"]10-05-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92505 APERITIF[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]BEVERAGE[/TD]

[TD="class: xl65"]10-05-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92800 APERITIF[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]BEVERAGE[/TD]

[TD="class: xl65"]10-05-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92905 SPICES[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]FOOD[/TD]

[TD="class: xl65"]10-05-17[/TD]
[TD="class: xl66"]ISSUE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92608 COFFEE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]HOT BEVERAGE[/TD]

[TD="class: xl65"]10-05-17[/TD]
[TD="class: xl66"]ISSUE
[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]92700 COFFEE[/TD]
[TD="class: xl66"] [/TD]
[TD="class: xl66"]HOT BEVERAGE[/TD]

</tbody>
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
Try this:-
NB:- Add to list in code as required.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG23Nov28
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("D2"), Range("D" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
.Add ("Beverage"), "APERITIF"
.Add ("Food"), "SPICES"
.Add ("Hot Beverage"), "COFFEE"
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Left(Dn.Value, 2) = 92 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] InStr(Dn.Value, .Item(Dn.Offset(, 2).Value)) = 0 [COLOR="Navy"]Then[/COLOR]
        Dn.Value = Dn.Value & " " & .Item(Dn.Offset(, 2).Value)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Or

Create a table Category - Description (gray area) in H2:I4
IMPORTANT: the categories must be in alphabetical order

Before macro

[TABLE="class: grid"]
<tbody>[TR]
[TD="bgcolor: #DCE6F1"][/TD]
[TD="bgcolor: #DCE6F1"]
A​
[/TD]
[TD="bgcolor: #DCE6F1"]
B​
[/TD]
[TD="bgcolor: #DCE6F1"]
C​
[/TD]
[TD="bgcolor: #DCE6F1"]
D​
[/TD]
[TD="bgcolor: #DCE6F1"]
E​
[/TD]
[TD="bgcolor: #DCE6F1"]
F​
[/TD]
[TD="bgcolor: #DCE6F1"]
G​
[/TD]
[TD="bgcolor: #DCE6F1"]
H​
[/TD]
[TD="bgcolor: #DCE6F1"]
I​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
1​
[/TD]
[TD]
DATE​
[/TD]
[TD]
TYPE​
[/TD]
[TD]
REF.1​
[/TD]
[TD]
REF.2​
[/TD]
[TD]
TR. NO​
[/TD]
[TD]
CATEGORY​
[/TD]
[TD][/TD]
[TD]
Category​
[/TD]
[TD]
Description​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
2​
[/TD]
[TD]
03/02/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92145​
[/TD]
[TD][/TD]
[TD]
BEVERAGE​
[/TD]
[TD][/TD]
[TD="bgcolor: #D9D9D9"]
BEVERAGE​
[/TD]
[TD="bgcolor: #D9D9D9"]
APERITIF​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
3​
[/TD]
[TD]
10/05/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92505​
[/TD]
[TD][/TD]
[TD]
BEVERAGE​
[/TD]
[TD][/TD]
[TD="bgcolor: #D9D9D9"]
FOOD​
[/TD]
[TD="bgcolor: #D9D9D9"]
SPICES​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
4​
[/TD]
[TD]
10/05/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92800​
[/TD]
[TD][/TD]
[TD]
BEVERAGE​
[/TD]
[TD][/TD]
[TD="bgcolor: #D9D9D9"]
HOT BEVERAGE​
[/TD]
[TD="bgcolor: #D9D9D9"]
COFFEE​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
5​
[/TD]
[TD]
10/05/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92905​
[/TD]
[TD][/TD]
[TD]
FOOD​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
6​
[/TD]
[TD]
10/05/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92608​
[/TD]
[TD][/TD]
[TD]
HOT BEVERAGE​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
7​
[/TD]
[TD]
10/05/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92700​
[/TD]
[TD][/TD]
[TD]
HOT BEVERAGE​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Macro
Code: 
Sub aTest()
    Dim LR As Long
    
    LR = Cells(Rows.Count, "D").End(xlUp).Row
    With Range("D2:D" & LR)
        .Value = Evaluate("=IF(ROW(2:" & LR & ")," & .Address & "&"" ""&LOOKUP(F$2:F$" & LR & ",H$2:H$4,I$2:I$4))")
    End With
End Sub

After macro

[TABLE="class: grid"]
<tbody>[TR]
[TD="bgcolor: #DCE6F1"][/TD]
[TD="bgcolor: #DCE6F1"]
A​
[/TD]
[TD="bgcolor: #DCE6F1"]
B​
[/TD]
[TD="bgcolor: #DCE6F1"]
C​
[/TD]
[TD="bgcolor: #DCE6F1"]
D​
[/TD]
[TD="bgcolor: #DCE6F1"]
E​
[/TD]
[TD="bgcolor: #DCE6F1"]
F​
[/TD]
[TD="bgcolor: #DCE6F1"]
G​
[/TD]
[TD="bgcolor: #DCE6F1"]
H​
[/TD]
[TD="bgcolor: #DCE6F1"]
I​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
1​
[/TD]
[TD]
DATE​
[/TD]
[TD]
TYPE​
[/TD]
[TD]
REF.1​
[/TD]
[TD]
REF.2​
[/TD]
[TD]
TR. NO​
[/TD]
[TD]
CATEGORY​
[/TD]
[TD][/TD]
[TD]
Category​
[/TD]
[TD]
Description​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
2​
[/TD]
[TD]
03/02/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92145 APERITIF​
[/TD]
[TD][/TD]
[TD]
BEVERAGE​
[/TD]
[TD][/TD]
[TD="bgcolor: #D9D9D9"]
BEVERAGE​
[/TD]
[TD="bgcolor: #D9D9D9"]
APERITIF​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
3​
[/TD]
[TD]
10/05/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92505 APERITIF​
[/TD]
[TD][/TD]
[TD]
BEVERAGE​
[/TD]
[TD][/TD]
[TD="bgcolor: #D9D9D9"]
FOOD​
[/TD]
[TD="bgcolor: #D9D9D9"]
SPICES​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
4​
[/TD]
[TD]
10/05/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92800 APERITIF​
[/TD]
[TD][/TD]
[TD]
BEVERAGE​
[/TD]
[TD][/TD]
[TD="bgcolor: #D9D9D9"]
HOT BEVERAGE​
[/TD]
[TD="bgcolor: #D9D9D9"]
COFFEE​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
5​
[/TD]
[TD]
10/05/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92905 SPICES​
[/TD]
[TD][/TD]
[TD]
FOOD​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
6​
[/TD]
[TD]
10/05/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92608 COFFEE​
[/TD]
[TD][/TD]
[TD]
HOT BEVERAGE​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #DCE6F1"]
7​
[/TD]
[TD]
10/05/2017​
[/TD]
[TD]
ISSUE​
[/TD]
[TD][/TD]
[TD]
92700 COFFEE​
[/TD]
[TD][/TD]
[TD]
HOT BEVERAGE​
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


M.
 
Upvote 0
Panoos64,

If I understand you correctly, then, here is a macro solution for you to consider, that is based on your two screenshots.

The cells in SCH.1.1 column D will be replaced by the cells in SCH.2. column D.

Code: 
Sub EnterDescription()
' hiker95, 11/23/2017, ME1032673
Application.ScreenUpdating = False
Dim d As Range, ref2 As Range, t As String
With Sheets("SCH.1.")
  For Each d In Range("D2", Range("D" & Rows.Count).End(xlUp))
    t = d.Value & "*"
    Set ref2 = Sheets("SCH.2.").Columns(4).Find(t)
    If Not ref2 Is Nothing Then
      d = Sheets("SCH.2.").Range("D" & ref2.Row)
    End If
  Next d
  .Columns(4).AutoFit
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi Mick, It works perfect and nicely. Thank you so much for your support and your time spent for me. Have a great lovely day!
 
Upvote 0
Hi hiker, I do not use 2 sheets. I just wanted to run and change the data in the same sheet. I tested the code with two sheets but it doesn't work. However i appreciated your support, and thank you so much for your time. Have a nice day!
 
Upvote 0
Hi Marcelo, i created the table base on your instructions and it works perfect. I would like to improve my knowledge and to ask you if is possible to assign the Table into the macro command. Many thanks also for your support!
 
Last edited:
Upvote 0
Panoos64 said:
Hi Marcelo, i created the table base on your instructions and it works perfect. I would like to improve my knowledge and to ask you if is possible to assign the Table into the macro command. Many thanks also for your support!
Click to expand...


Maybe...

Code: 
Sub aTestV2()
    Dim LR As Long, rTable As Range, sAddC1 As String, sAddC2 As String
    
    'Set table Category - Description range
    Set rTable = Range("H2:I" & Cells(Rows.Count, "H").End(xlUp).Row)
    'Address of table first colunm
    sAddC1 = rTable.Columns(1).Address
    'Address of table second column
    sAddC2 = rTable.Columns(2).Address
    
    'Last row with data
    LR = Cells(Rows.Count, "D").End(xlUp).Row
    
    With Range("D2:D" & LR)
        .Value = Evaluate("=IF(ROW(2:" & LR & ")," & .Address & "&"" ""&LOOKUP(F$2:F$" _
            & LR & "," & sAddC1 & "," & sAddC2 & "))")
    End With
End Sub

M.
 
Upvote 0
A simpler version

Code: 
Sub aTestV3()
    Dim LR As Long, sTblAdd As String
    
    'Set table Category - Description address
    sTblAdd = Range("H2:I" & Cells(Rows.Count, "H").End(xlUp).Row).Address
        
    'Last row with data
    LR = Cells(Rows.Count, "D").End(xlUp).Row
    
    With Range("D2:D" & LR)
        .Value = Evaluate("=IF(ROW(2:" & LR & ")," & .Address & "&"" ""&LOOKUP(F$2:F$" _
            & LR & "," & sTblAdd & "))")
    End With
End Sub

M.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Pull unique names refrencing date field
Replies
3
Views
701
Fluff
Fluff
J
  • Question Question
Lookup
Replies
4
Views
526
Johnboy28
J
P
  • Question Question
Drop Down List
Replies
0
Views
479
Panoos64
P
J
  • Question Question
Sumproduct only if multiple criteria is met in multiple rows
Replies
6
Views
628
John Luther
J
P
  • Question Question
Enter category next to a number
Replies
2
Views
738
Panoos64
P

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top