Enter description next to a number

P

Panoos64

Well-known Member
Joined
Mar 1, 2014
Messages
882
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.
ABCDEF
1DATETYPEREF.1REF.2TR. NOCATEGORY
203-02-17ISSUE 92145 BEVERAGE
310-05-17ISSUE 92505 BEVERAGE
410-05-17ISSUE 92800 BEVERAGE
510-05-17ISSUE 92905 FOOD
610-05-17ISSUE 92608 HOT BEVERAGE
710-05-17ISSUE 92700 HOT BEVERAGE

<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>
</tbody>



SCH.2.
ABCDEF
1DATETYPEREF.1REF.2TR. NOCATEGORY
203-02-17ISSUE 92145 APERITIF BEVERAGE
310-05-17ISSUE 92505 APERITIF BEVERAGE
410-05-17ISSUE 92800 APERITIF BEVERAGE
510-05-17ISSUE 92905 SPICES FOOD
610-05-17ISSUE 92608 COFFEE HOT BEVERAGE
710-05-17ISSUE
 92700 COFFEE HOT BEVERAGE

<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>
</tbody>
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
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

A​
B​
C​
D​
E​
F​
G​
H​
I​
1​
DATE​
TYPE​
REF.1​
REF.2​
TR. NO​
CATEGORY​
Category​
Description​
2​
03/02/2017​
ISSUE​
92145​
BEVERAGE​
BEVERAGE​
APERITIF​
3​
10/05/2017​
ISSUE​
92505​
BEVERAGE​
FOOD​
SPICES​
4​
10/05/2017​
ISSUE​
92800​
BEVERAGE​
HOT BEVERAGE​
COFFEE​
5​
10/05/2017​
ISSUE​
92905​
FOOD​
6​
10/05/2017​
ISSUE​
92608​
HOT BEVERAGE​
7​
10/05/2017​
ISSUE​
92700​
HOT BEVERAGE​

<tbody>
</tbody>


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

A​
B​
C​
D​
E​
F​
G​
H​
I​
1​
DATE​
TYPE​
REF.1​
REF.2​
TR. NO​
CATEGORY​
Category​
Description​
2​
03/02/2017​
ISSUE​
92145 APERITIF​
BEVERAGE​
BEVERAGE​
APERITIF​
3​
10/05/2017​
ISSUE​
92505 APERITIF​
BEVERAGE​
FOOD​
SPICES​
4​
10/05/2017​
ISSUE​
92800 APERITIF​
BEVERAGE​
HOT BEVERAGE​
COFFEE​
5​
10/05/2017​
ISSUE​
92905 SPICES​
FOOD​
6​
10/05/2017​
ISSUE​
92608 COFFEE​
HOT BEVERAGE​
7​
10/05/2017​
ISSUE​
92700 COFFEE​
HOT BEVERAGE​

<tbody>
</tbody>


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
Pull unique names refrencing date field
Replies
3
Views
625
Fluff
Fluff
J
  • Question
Lookup
Replies
4
Views
466
Johnboy28
J
P
  • Question
Drop Down List
Replies
0
Views
422
Panoos64
P
J
  • Question
Sumproduct only if multiple criteria is met in multiple rows
Replies
6
Views
561
John Luther
J
P
  • Question
Enter category next to a number
Replies
2
Views
666
Panoos64
P

Forum statistics

Threads
1,215,430
Messages
6,124,852
Members
449,194
Latest member
HellScout

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