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