I have a barcode scanner USB plug&play which is giving a string of data in one cell of Excel in this form 4449520450061198001
I want to split this data automatically in different cells everytime my scanner reads the code.
Please help.
Regards,
UPDATED
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const ws_range = "A1:A10"
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Integer, k As Integer
Dim codestr As String
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
codestr = Target.Text
If Target <> "" Then
If Not Intersect(Target, Me.Range(ws_range)) Is Nothing Then
With Target
k = Len(codestr)
i = 2
Do Until i = k + 2
ws.Cells(Target.Row, i).Value = Mid(codestr, i - 1, 1)
i = i + 1
Loop
End With
End If
End If
End Sub
I haven't fully tested this but now after a value is inserted into column a it will be split into the cells to the right. Obviously modify A1:A10 to match what you need.
Related
I have a workbook (A) in which I have one module with one subroutine. The subroutine downloads an excel file (workbook(B)) from the internet and opens it. The problem I'm faced with is finding a way to execute a subroutine in workbook (B) from the sub in workbook (A).
To reiterate, I have my desired subroutine only in workbook (A) and wish to apply it to workbook (B) by use of the sub in workbook (A).
Note: In my code workbook (B) = Nuance Mobility JIRA.xls and the desired subroutine in workbook (B) that needs to be executed is removeColumns().
My code can be found below :
Public Sub DL()
Dim WebUrl As String
Dim x As Workbook
Dim z As Workbook
Dim nmjexcel As String
Dim xlApp As Excel.Application
' I check to see if the file exists and delete it if it does
nmjexcel = "C:\Users\" & [A2] & "\Downloads\Nuance Mobility JIRA.xls"
If Len(Dir(nmjexcel)) <> 0 Then
SetAttr nmjexcel, vbNormal
Kill nmjexcel
End If
'I open chrome and download the file from an URL
WebUrl = [J1]
Shell ("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe -url " & WebUrl)
Application.Wait (Now + TimeValue("0:00:3"))
'I create a new 'hidden' excel app and open workbook (B)
Set xlApp = New Excel.Application
xlApp.Visible = False
Set x = Workbooks.Open("C:\Users\" & [A2] & "\Downloads\Nuance Mobility JIRA.xls")
' I delete some rows, a picture and some columns.
' It's here that i would like my other subroutine, removeColumns(), to take place !
With x.Sheets("general_report")
.Rows("1:3").Delete
.Shapes.Range(Array("Picture 1")).Delete
.Cells.UnMerge
.Range("A:A,D:D,E:E,F:F,H:H,I:I,J:J,K:K,L:L,M:M,N:N,O:O,P:P").Delete Shift:=xlToLeft
End With
'Then I copy whats left and paste it into workbook (A)
Set z = ThisWorkbook
Application.ScreenUpdating = False
x.Sheets("general_report").Range("A1").CurrentRegion.Copy
z.Sheets(1).Range("A13").PasteSpecial xlValues
x.Save
x.Application.CutCopyMode = False
x.Close
End Sub
My desired sub to be executed is the following
Sub removeColumns()
Dim rng As Range 'store the range you want to delete
Dim c 'total count of columns
Dim I 'an index
Dim j 'another index
Dim headName As String 'The text on the header
Dim Status As String 'This vars is just to get the code cleaner
Dim Name As String
Dim Age As String
Dim sht As Worksheet
Rows("1:3").Delete
Key = "Key"
Summary = "Summary"
Status = "Status"
Set sht = Sheets("general_report")
sht.Activate 'all the work in the sheet "Incidents"
c = Range("A1").End(xlToRight).Column
'From A1 to the left at the end, and then store the number
'of the column, that is, the last column
j = 0 'initialize the var
For I = 1 To c 'all the numbers (heres is the columns) from 1 to c
headName = Cells(1, I).Value
If (headName <> Key) And (headName <> Summary) And (headName <> Status) Then
'if the header of the column is differente of any of the options
j = j + 1 ' ini the counter
If j = 1 Then 'if is the first then
Set rng = Columns(I)
Else
Set rng = Union(rng, Columns(I))
End If
End If
Next I
rng.Delete 'then brutally erased from leaf
End Sub
Thank you very much in advance !
Further questions :
1) Is there a way to keep the downloaded excel hidden ?
I have :
Set xlApp = New Excel.Application
xlApp.Visible = False
Set x = Workbooks.Open("C:\Users\" & [A2] & "\Downloads\Nuance Mobility JIRA.xls")
But if i use x= xlApp.Workbooks.Open it gives me an error 'subscript out of range' and highlights :
Set sht = Sheets("general_report")
I tried doing
Dim xlApp as Excel.Application)
...
Set sht = xlApp.Sheets("general_report")
But it gets more errors
2) More generally, is their a way to keep the focus on my workbook (A), so that when chrome downloads the workbook (B) the chrome window doesn't pop up in front ?
The problem you are facing, occurs because you dont directly address the needed worksheet/workbook, you rather always use the Selected worksheet, which you shouldn´t. It´s unclear and can be done just as simple if directly referring.
To refer to the worbookB I added a parameter to the sub removeColumns, so you can pass the needed workbook.
In the sub then, you just need to use the reference wherever you are working with the worksheet.
So instead of just writing:
somVariable = Cells(1,1).Value 'This always refers to the 'Selected' worksheet
You have to write:
someVariable = myWorkbook.myWorksheet.Cells(1,1).Value
'or to use the parameter wb like i did in your code:
someVariable = wb.Sheets(1).Cells(1,1).Value
'Here the first sheet of this workbook will be used
'You also can use the 'With' statment here:
With wb.Sheets(1)
someVariable = .Cells(1,1).Value 'Note the dot in font of the 'Cells'
End With
So to use this knowledge in you example, you should try to alter code like following:
/////////////////////////////////////////////////////////////////////////
Set xlApp = New Excel.Application
xlApp.Visible = False
xlApp.Workbooks.Open("C:\Users\" & [A2] & "\Downloads\Nuance Mobility JIRA.xls")
Set x = xlApp.Workbooks(1)
Call removeColumns(x)
/////////////////////////////////////////////////////////////////////////
Sub removeColumns(ByVal wb As Workbok)
...
'Always when you are referring to the workbook, you have to use the reference passed as parameter
wb.Sheets("general_report").Rows("1:3").Delete
'In you code the first three rows will always be deleted from the 'Selected' sheet and not the one you are working on later, the 'general_report'
...
Set sht = wb.Sheets("general_report")
'Also don´t activate() sheet here, youst directly refer to it later
'sht.Activate 'all the work in the sheet "Incidents"
'You can directly refer t it over the variable you created, like this:
c = sht.Range("A1").End(xlToRight).Column
'From A1 to the left at the end, and then store the number
'of the column, that is, the last column
j = 0 'initialize the var
For I = 1 To c 'all the numbers (heres is the columns) from 1 to c
headName = sht.Cells(1, I).Value
If (headName <> Key) And (headName <> Summary) And (headName <> Status) Then
'if the header of the column is differente of any of the options
j = j + 1 ' ini the counter
If j = 1 Then 'if is the first then
Set rng = sht.Columns(I)
Else
Set rng = Union(rng, sht.Columns(I))
End If
End If
Next I
rng.Delete 'then brutally erased from leaf
End Sub
Hope I could help and if something is still unclear feel free to ask.
Essentially I'm creating a tracking sheet which will have a cell on it that, when clicked, will create a new excel sheet in the same workbook. For testing purposes I'm currently just having it create a new sheet, but eventually I'll have a sheet that it'll copy. What I need help with is, how do I get VB to pull a cell value to use as the name of the new/copied sheet? Here's the scenario:
Each row will have a Client column (which is Column C) which I want to use for the names of the workbooks that will be created. I'm trying to have a cell (say column R in that row) that when clicked creates a new worksheet and pulls in the value of column C in that row as the worksheet's name.
So, say Row 5 has "Test Client" in C5. When R5 is clicked, I want it to create a sheet that is named "Test Client". I've seen solutions that use loops to go through the column and create a sheet for each, but that wouldn't really work for my scenario as I'd need them to be created on the fly and not always for each row.
I know how to create the sheets in vb but my issue is getting the name. Is there a way to get vba to pull the name from column C for the row in which it was activated? So if it was activated for Row 5, it pulls C5, if it was Row 10, it pulls C10 etc.
Any suggestions would be greatly appreciated, I'm currently using this to create the sheets:
Sub CreateSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
End Sub
and this to call:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then Call CreateSheet
End Sub
The code below reads the value in Column C for the relevant row, and then passes it as a String to your Function:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then
Dim ShtName As String
ShtName = Cells(Target.Row, "C").Value
Call CreateSheet(ShtName)
End If
End Sub
This is your function, I've added a String that is passed representing the worksheet name:
Public Sub CreateSheet(ws_Name As String)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = ws_Name
End Sub
Update: As Shai Rado pointed out I was missing an error handler.
You should test to see if the worksheet exists first. This pattern will make it easier to debug and add functionality to your code.
Worksheet Module
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet
Dim WorksheetName As String
If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then
WorksheetName = Cells(Target.Row, "C").Value
Set ws = getWorkSheet(WorksheetName)
If Not ws Is Nothing Then Set ws = getNewWorkSheet(WorksheetName)
End If
End Sub
Standard Module
Function getWorkSheet(WorksheetName As String, Optional WorkbookName As String) As Worksheet
If Len(WorkbookName) = 0 Then WorkbookName = ThisWorkbook.Name
With Workbooks(WorkbookName)
On Error Resume Next
Set getWorkSheet = .Worksheets(WorksheetName)
On Error GoTo 0
End With
End Function
Function getNewWorkSheet(WorksheetName As String, Optional WorkbookName As String) As Worksheet
Dim ws As Worksheet
If Len(WorkbookName) = 0 Then WorkbookName = ThisWorkbook.Name
With Workbooks(WorkbookName)
Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
On Error Resume Next
ws.Name = WorksheetName
If Err.Number = 0 Then
Set getNewWorkSheet = ws
Else
ws.Delete
End If
On Error GoTo 0
End With
End Function
I have a project in which I have to change to value of a textbox to a value that is searched in a workseet against a vlaue that has been selected from a combobox. for example if I select "A" from the combobox the it should search the worksheet "test" find the input for A and change the text box value to 1 as this is the value entered for A. I have looked at some of the other questions that have been asked here but could not seem to get it to work for me. Below is the code that I have been trying to use.
Private Sub IDComboBox_Change()
Dim domainRange As Range
Dim listRange As Range
Dim selectedString As Variant
Dim lastRow As Long
If IDComboBox.ListIndex <> -1 Then
selectedString = IDComboBox.Value
lastRow = Worksheets("test").Range("A" & Rows.Count).End(xlUp).Row
Set listRange = Worksheets("test").Range("A2:A" & lastRow)
For Each domainRange In listRange
If domainRange.Value = selectedString Then
DomainOwnerTestBox.Value = "test"
End If
Next domainRange
End If
End Sub
Any help would be great. If you need anymore information then please let me know and also please be paient with me as im new to VBA.
Thanks
Try this code. It uses Excel built-in MATCH function to search for value in column A of worksheet 'test'.
Private Sub IDComboBox_Change()
Dim wks As Excel.Worksheet
Dim selectedString As Variant
Dim row As Long
Dim value As Variant
Set wks = Worksheets("test")
If IDComboBox.ListIndex <> -1 Then
selectedString = IDComboBox.value
On Error Resume Next
row = Application.WorksheetFunction.Match(selectedString, wks.Columns(1), 0)
On Error GoTo 0
If row Then
value = wks.Cells(row, 2) '<--- assuming that input values are in column 2.
DomainOwnerTestBox.value = value
Else
'Value not found in the worksheet 'test'
End If
End If
End Sub
Is it possible that my macro (update () ) auto-executes everytime the excel file is opened. The code below doesn't work well. Thanks
Private Sub Workbook_Open()
Run "update"
End Sub
Option Explicit
Sub update()
Dim rng As Range
Dim Sh As String, Cl As String
Dim ws As Worksheet
Dim i As Integer, ncol As Integer
Dim Row1 As String
ncol = Range("B1:O1").Columns.Count
For i = 1 To ncol
Set ws = ThisWorkbook.Sheets("sheet1")
With ws
Row1 = .Cells(1, i).Value
If Len(Row1) > 0 Then
Sh = Split(Row1, "'!")(0)
Cl = Split(Row1, "'!")(1)
Set rng = ThisWorkbook.Sheets(Sh).Range(Cl)
'Here you were always refering to cell A2 not moving through the values which was the main problem.
rng.Value = .Cells(2, i).Value
End If
End With
Next i
End Sub
As mentioned in the comments. Move the following:
Private Sub Workbook_Open()
Run "update"
End Sub
To here:
As mentioned by Siddharth there is another way to get a macro to run on the file open event and that is to simply to give it the following signature:
Sub Auto_Open
Also, personally I'd probably not call a sub-routine just "update" as it is quite close to lots of reserved words - I'd go for something like "updateSomething". This is just personal choice.
I wrote a macro and while it works, functionally its not what is needed. It's an interactive checklist that breaks down multiple areas of machines and if they are working checks them off and then this updates a master list with multiple sections. However, it only works with one cell at a time and it needs to be able to work with multiple cells at a time (both with rows and columns). Here's my current code:
'Updates needed:
' Make so more than one cell works at a time
' in both x and y directions
Private Sub Worksheet_Change(ByVal Target As Excel.range)
Dim wb As Workbook
Dim mWS As Worksheet
Dim conName As String
Dim mCol As range
Dim mCon As Integer
Dim count As Long
Dim cell As range
Dim y As String
count = 1
y = ""
Set wb = ActiveWorkbook
Set mWS = wb.Sheets("Master")
Set mCol = mWS.range("B:B")
mCon = 0
'Selects the name of the string value in which we need to search for in master list
If Target.Column < 100 Then
ThisRow = Target.Row
conName = ActiveSheet.Cells(ThisRow, "B")
y = Target.Value
End If
'search for matching string value in master list
For Each cell In mCol
If cell.Value = conName Then
mCon = count
Exit For
End If
count = count + 1
Next
'mark as "x" in Master list
Dim cVal As Variant
Set cVal = mWS.Cells(count, Target.Column)
cVal.Value = y
End Sub
What is happening - If I drag down "x" for multiple rows or columns my codes breaks at y = Target.Value and will only update the cell I first selected and its counterpart on the master list. What it should do is if I drag and drop the "x" onto multiple rows of columns it should update all of them in the sheet I'm working on and the master list. I only set up the macro for one cell at a time and I have no idea how to set it up for dragging and dropping the "x" value for multiple rows
I think you need a For ... Each iteration over the Target in order to work with multiple cells. As Michael noted in the comments, the _Change event fires only once, but the Target reflects all cell(s) that changed, so you should be able to iterate over the Target range. I tested using this simple event handler:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range
Dim myCell As Range
Set myRange = Target
For Each myCell In myRange.Cells
Debug.Print myCell.Address
Next
End Sub
I am not able to test obviously on your data/worksheet, but I think it should put you on the right track.
Private Sub Worksheet_Change(ByVal Target As Excel.range)
Dim wb As Workbook
Dim mWS As Worksheet
Dim conName As String
Dim mCol As range
Dim mCon As Integer
Dim count As Long
Dim cell As range
Dim y As String
count = 1
y = ""
Set wb = ActiveWorkbook
Set mWS = wb.Sheets("Master")
Set mCol = mWS.range("B:B")
mCon = 0
'Add some new variables:
Dim myRange as Range
Dim myCell as Range
Set myRange = Target
Application.EnableEvents = False '## prevents infinite loop
For each myCell in myRange.Cells
If myCell.Column < 100 Then
ThisRow = myCell.Row
conName = ActiveSheet.Cells(ThisRow, "B")
y = myCell.Value
End If
'search for matching string value in master list
For Each cell In mCol
If cell.Value = conName Then
mCon = count
Exit For
End If
count = count + 1
Next
'mark as "x" in Master list
Dim cVal As Variant
Set cVal = mWS.Cells(count, Target.Column)
cVal.Value = y
Next
Application.EnableEvents = True '## restores event handling to True
End Sub
You need to iterate through the cells using a ForEach loop.
Also, you may be better using the Selection object rather than Target
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each cell In Selection
Debug.Print cell.Address
Next cell
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub