Hedengren
01-15-2017, 11:41 PM
Hi!
A fellow on the internet posted some code that I am trying to use for my own project. The code controls how the input from a QR-reader is printed out in an Excel Spreadsheet.
The code is written so that when a QR-code is read it prints out the QR-code in column A and a time stamp is printed out in column C. When the same QR-code is read a second time it prints out another time stamp next to the previous one.
For my project, if the QR-code is scanned a second time I want the entire row that the QR-code and time stamp is on - to be deleted. I've tried altering the code but I'm having trouble with deleting the right row.
Does anyone have any advice on how to write the code so that this could be possible?
I'm glad for any help and advices.:)
This how it looks now when QR-codes are read and printed to the spreadsheet:
18042
This is the code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A3000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim lc As Long, fr As Long, n As Long, nr As Long
With Application
.EnableEvents = False
.ScreenUpdating = False
n = Application.CountIf(Columns(1), Cells(Target.Row, 1))
If n = 1 Then
lc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column
If lc = 1 Then
Cells(Target.Row, lc + 2) = Format(Now, "m/d/yyyy h:mm")
ElseIf lc > 2 Then
Cells(Target.Row, lc + 1) = Format(Now, "m/d/yyyy h:mm")
End If
Else
fr = 0
On Error Resume Next
fr = Application.Match(Cells(Target.Row, 1), Columns(1), 0)
On Error GoTo 0
If fr > 0 Then
lc = Cells(fr, Columns.Count).End(xlToLeft).Column
If lc = 1 Then
Cells(fr, lc + 2) = Format(Now, "m/d/yyyy h:mm")
ElseIf lc > 2 Then
Cells(fr, lc + 1) = Format(Now, "m/d/yyyy h:mm")
End If
Target.ClearContents
End If
End If
On Error Resume Next
Me.Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
nr = Me.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Me.Cells(nr, 1).Select
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
A fellow on the internet posted some code that I am trying to use for my own project. The code controls how the input from a QR-reader is printed out in an Excel Spreadsheet.
The code is written so that when a QR-code is read it prints out the QR-code in column A and a time stamp is printed out in column C. When the same QR-code is read a second time it prints out another time stamp next to the previous one.
For my project, if the QR-code is scanned a second time I want the entire row that the QR-code and time stamp is on - to be deleted. I've tried altering the code but I'm having trouble with deleting the right row.
Does anyone have any advice on how to write the code so that this could be possible?
I'm glad for any help and advices.:)
This how it looks now when QR-codes are read and printed to the spreadsheet:
18042
This is the code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A3000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim lc As Long, fr As Long, n As Long, nr As Long
With Application
.EnableEvents = False
.ScreenUpdating = False
n = Application.CountIf(Columns(1), Cells(Target.Row, 1))
If n = 1 Then
lc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column
If lc = 1 Then
Cells(Target.Row, lc + 2) = Format(Now, "m/d/yyyy h:mm")
ElseIf lc > 2 Then
Cells(Target.Row, lc + 1) = Format(Now, "m/d/yyyy h:mm")
End If
Else
fr = 0
On Error Resume Next
fr = Application.Match(Cells(Target.Row, 1), Columns(1), 0)
On Error GoTo 0
If fr > 0 Then
lc = Cells(fr, Columns.Count).End(xlToLeft).Column
If lc = 1 Then
Cells(fr, lc + 2) = Format(Now, "m/d/yyyy h:mm")
ElseIf lc > 2 Then
Cells(fr, lc + 1) = Format(Now, "m/d/yyyy h:mm")
End If
Target.ClearContents
End If
End If
On Error Resume Next
Me.Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
nr = Me.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Me.Cells(nr, 1).Select
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub