Creating barcodes in Excel - vba

Question

I am using barcode font to generate barcodes,
column A text - *column B Barcode*
I have the following macro in ThisWorkbook which works okay.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If IsEmpty(Target) Or Target.Column <> 1 And Target.Column <> 4 Then Exit Sub
Dim DataRow As Integer
DataRow = Target.Cells.Row
While Not IsEmpty(Cells(DataRow, Target.Column))
Target.Worksheet.Cells(DataRow, Target.Column + 1) = "*" & Target.Worksheet.Cells(DataRow, Target.Column) & "*"
DataRow = DataRow + 1
Wend
End Sub
when I scan 22 digit # in column A; on column B would like to skip the first 7 digit and have the last 15 digit on column B
e.g:
If 22 digit skip first 7
If 32 digit skip first 16 & last 4
If 34 digit skip first 22

Answer 1

First off, the sh parameter of the Workbook_SheetChange event macro is the worksheet object containing Target. You can use it directly; there is no need to pare the worksheet from Target.
Next, it is always a good idea when adding/modifying/deleting objects within a Worksheet_Change or Workbook_SheetChange event macro to turn off application.enableevents so the macro does not try to run on top of itself when it changes/deleted/adds a value on the same (or different) worksheet.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Sh.Range("A:A, D:D"), Target) Is Nothing Then
On Error GoTo Fìn
Application.EnableEvents = False
Dim DataRow As Long, rng As Range
For Each rng In Intersect(Sh.Range("A:A, D:D"), Target)
Select Case Len(rng.Value2)
Case 0
'do nothing
Case 22
rng.Offset(0, 1) = Chr(42) & Mid(rng.Value2, 8, 99) & Chr(42)
Case 32
rng.Offset(0, 1) = Chr(42) & Mid(rng.Value2, 8, 21) & Chr(42)
Case 34
rng.Offset(0, 1) = Chr(42) & Mid(rng.Value2, 23, 99) & Chr(42)
Case Else
rng.Offset(0, 1) = Chr(42) & rng.Value2 & Chr(42)
End Select
Next rng
End If
Fìn:
Application.EnableEvents = True
End Sub
Target knows which worksheet it is on so there is really no need to define the worksheet when referencing a cell offset to Target.
A Select Case ... End Select` based on the length of the values in Target seemed the best solution and allows for easy expandability.
And finally, do you really need this for multiple worksheets as a Workbook_SheetChange event macro or would a single worksheet's Worksheet_Change suffice?

Answer 2

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim tmp,v
Dim c As Range
On Error Goto haveError
For Each c in Target.Cells
tmp=trim(c.Value)
If Len(tmp) > 0 And (c.Column=1 Or c.Column=4) Then
Select Case Len(tmp)
Case 22: v = Right(tmp, Len(tmp)-7)
Case 32: 'etc
Case 34: 'etc
Case Else: v=""
End Select
If Len(v)>0 Then
Application.EnableEvents = False
c.offset(0,1).value = "*" & v & "*"
Application.EnableEvents = True
End If
End If
Next c
Exit sub
haveError:
Application.EnableEvents = True
End Sub