0

Im using a scanner, which fills out an Exel Sheet. Everytime a label which contains a Mac and a Serial number gets scanned it writes it into a cell. I want to delete everything behind (and including ) the "," The Position of the "," is: ,"ss".

This VBA programm should delete :" ss:******************" in every cell, but it doesn´t work, and it gives no error code feedback.

Here is my Code:

    Sub loeschen()

Dim sn As String
Dim mac As String
Dim Cache As String

sn = "***************************ss*:*******************"
If ActiveCell.Value = sn Then
Cache = ActiveCell.Value
mac = Left(Cache, InStr(1, Cache, ",") - 1)

ActiveCell.Value = mac
End If

End Sub

Im gratefull for any help or suggetions.

Current Version:

    Sub loeschen()
    
    Dim sn As String
    Dim mac As String
    Dim Cache As String
    Dim T As Boolean
    T = True
    
    If Mid(ActiveCell, 28, 2) = "ss" Then
    Cache = ActiveCell.Value
    mac = Left(Cache, InStr(1, Cache, ",") - 1)
    
    ActiveCell.Value = mac
    End If
    
    Application.DisplayAlerts = False
    
    ActiveWorkbook.SaveAs "U:\Desktop\a" & Format(Date, "dd.mm.yyyy") & ".xlsm"
    
    Application.DisplayAlerts = True
    
    End Sub
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Target.Worksheet.ActiveCell) Is Nothing Then loeschen
    End Sub

Edit: I had to overthink the process and the programm, i have to make some adjustments for it to be usefull.

1. It has to get the information from an .txt file 
2. then crop them by an user pressing a macro ( i would like the programm to run an counter "i" which goes through every Cell in the Column A and crops it)

The Data in the Txt File that is important looks like this;[![enter image description here][1]][1]


  [1]: https://i.stack.imgur.com/PWZrP.png

This is my current code: 

Sub loeschen()

Dim sn As String
Dim mac As String
Dim Cache As String
Dim i As Integer


Dim wbExcel As Workbook, wbText As Workbook
    Dim wsExcel As Worksheet
    Set wbExcel = ThisWorkbook 'specify here which Excel file the text file’s content is to be pasted into
    Set wsExcel = wbExcel.Sheets(1) 'specify here which worksheet to use
    Set wbText = Workbooks.Open("U:\Desktop\Data.txt") 'add here the path of your text file

    wbText.Sheets(1).Cells.Copy wsExcel.Cells

    wbText.Close SaveChanges:=False

  i = 1
    Do While Cells(i, 1).value <> "*"

If Mid(Cells(i, 1), 28, 2) = "ss" Then
Cache = Cells(i, 1).value
mac = Left(Cache, InStr(1, Cache, ",") - 1)

Cells(i, 1).value = mac
End If

'If Mid(ActiveCell, 28, 2) = "ss" Then
'Cache = ActiveCell.value
'mac = Left(Cache, InStr(1, Cache, ",") - 1)

'ActiveCell.value = mac
'End If


    Exit Do
        i = i + 1
    Loop
    
Application.DisplayAlerts = False

ActiveWorkbook.SaveAs "U:\Desktop\SHCDataold" & Format(Date, "dd.mm.yyyy") & ".xlsm"

Application.DisplayAlerts = True

End Sub

It gathers the information from the txt file and pastes it in the way i want.

Now i want to crop everything with an Macro: The problem is, that the ActiveCell has to increase everytime, so it can crop all of the data.

Question: How can i increase an Activecell with the Column A? Like: Activecell.Column("A1") +1

Valac
  • 29
  • 10
  • 2
    Your trimming statement (`mac = Left...`) looks fine, but your comparison is off (`ActiveCell.Value` is most likely *not* composed mostly of asterisks). Maybe you are looking for the [Like operator](https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/like-operator)? – Heinzi Jul 12 '22 at 08:04
  • 2
    Also, if those asterisks **are intended as wildcards**, then you should know that an asterisk represents ***any** number of characters* - so one each section would be sufficient. If you need to specify a *number of actual characters*, then use # to represent numerics and ? to represent any one character. – CLR Jul 12 '22 at 08:11
  • @Heinzi The asterisks are used as a placeholder, since an asterisks can be anything. – Valac Jul 12 '22 at 08:39
  • @Valac: I get your intention, but `=` performs an *exact* comparison, not a placeholder comparison. – Heinzi Jul 12 '22 at 08:51
  • @Heinzi You are right i updated the code, do you know how to make it loop so everytime the user scanns something the program executes? When i place an Do while ....... Loop , the program crashes. – Valac Jul 12 '22 at 09:00
  • 2
    Please don't modify your question to include the suggestions made in the answers. Otherwise, the answers will look wrong when read in the future. – Heinzi Jul 12 '22 at 09:01
  • @Valac: Yes, see the link I provided below IvanSTV's answer. – Heinzi Jul 12 '22 at 09:01
  • Not sure if I understood properly but if you want everything before *first comma* you may benefit from [Split](https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/split-function) and get always the index 0 of the array... – Foxfire And Burns And Burns Jul 12 '22 at 11:13
  • Could you share more accurately what's in your cell e.g. `123, ss456` or is it `123, "ss456"`and you need to remove `, ss456` or `, "ss456"` respectively, keeping only `123`. Also, you need to share the first row and the column (e.g. `A2`) where this is to be applied. `ActiveCell` is no good here. – VBasic2008 Jul 12 '22 at 13:06
  • @VBasic2008 ive edited my post, there you can see what kind of information could be in the cell (i alternated the information) also my programm needs some changes which i am struggling right now. Thanks for your help so far. – Valac Jul 12 '22 at 13:52

2 Answers2

1

seems, the problem is in following:

sn = "***************************ss*:*******************" 
If ActiveCell.Value = sn Then

better change on

 If Mid(ActiveCell, 28, 2) = "ss" Then
IvanSTV
  • 242
  • 1
  • 10
  • ive eddited the code and it works, now i want to let the program to do it everytime there is an input. If i do it with an While True > loop the programm breaks down – Valac Jul 12 '22 at 08:43
  • what range do you loop? You'd better describe the range and loop with for each cells in range( ) – IvanSTV Jul 12 '22 at 08:51
  • 1
    @Valac: [automatically execute an Excel macro on a cell change](https://stackoverflow.com/q/409434/87698) – Heinzi Jul 12 '22 at 08:52
  • @Heinzi Im sorry for asking, but could you please provide an edited version of it, i dont seem to know how to edit it to work in my code correctly. Also ive postet my current version of the code below the original. – Valac Jul 12 '22 at 09:08
  • @IvanSTV could you provide me with an code example? – Valac Jul 12 '22 at 09:18
  • the programm only gets info into Column A chronologically – Valac Jul 12 '22 at 09:20
  • 1
    @Valac: `Worksheet_Change` needs to go into your worksheet code file (the one with the name of your Excel file tab, e.g. "Table1"). Don't call it explicitly in loeschen. To keep it simple, you can just remove the If in Worksheet_Change and call loeschen directly. – Heinzi Jul 12 '22 at 09:33
  • @Heinzi ive done that now, but the code only chops after the "," when i press the run button. Ergo it doen´t execute on cell value change :/ – Valac Jul 12 '22 at 09:48
  • ` Set rng = Range(Cells(1, 1), Cells(ActiveSheet, UsedRange.Rows.count, 1)) For Each x In rng If Mid(x, 28, 2) = "ss" Then Cache = x.Value Mac = Left(Cache, InStr(1, Cache, ",") - 1) x.Value = Mac End If Next ` – IvanSTV Jul 12 '22 at 10:00
1

I created an UDF based on what you want. In your code you have:

mac = Left(Cache, InStr(1, Cache, ",") - 1)

So I guess you want everything before the comma. You may use Split for this:

enter image description here

Code of the UDF:

Public Function GET_LABEL(ByVal rng As Range) As String

If InStr(1, rng.Value, ",") > 0 Then
    GET_LABEL = Split(rng.Value, ",")(0)
Else
    'no comma, get all text
    GET_LABEL = rng.Value
End If


End Function