I have a simple sub, where the data and the result look like this :
It's just to do a transpose value from data in column-A to column-B.
Sub test()
Dim rw1 As Long: Dim rw2 As Long: Dim cnt As Long
Dim kode1 As String: Dim kode2 As String
Dim oStop As Boolean
rw1 = 2: rw2 = 2: cnt = 1
Do
Do
If oStop = False Then
kode1 = Right(Split(Cells(rw1, 1).Value, ".")(0), 4)
kode2 = Left(kode1, 3) & LCase(Split(Columns(cnt).Address(0, 0), ":")(0))
If kode1 = kode2 Then
rw1 = rw1 + 1: cnt = cnt + 1
If Cells(rw1, 1).Value = "" Then oStop = True: kode1 = "X"
End If
End If
Loop Until kode2 <> kode1
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, cnt - 1) = Application.Transpose(Cells(rw2, 1).Resize(cnt - 1, 1).Value)
rw2 = rw1: cnt = 1
Loop Until Cells(rw1, 1).Value = ""
End Sub
The code runs and gives the expected result without error but the problem is, sometimes after I do some editing on the sheet (like changing the data, clear cell, etc) when I run the sub again, Windows show a circular blue icon spinning for maybe 1 second, then Excel close by itself without warning. When I open again the workbook, there's no result ... so I guess there's something wrong with the code which causing Excel close by itself before it has the chance to write the transpose value to column B.
And more problem, I can't replicate the "closing by itself". I mean, after I open the workbook again, do some editing on the sheet, run the sub (expecting Excel will close by itself) but Excel not close by itself. But then later on, after I do some editing on the sheet then run the sub, Excel close again by itself.
To be honest, when I write the code - I myself feel that the code is "merry go round", too many if or maybe too many loop or maybe too long syntax. Would someone please tell me what is wrong with the code ?
I've been thinking to change the code by using findnext to find how many occurence of the looped value in column-A and then have it as cnt variable. But still I'm curious what's wrong with the sub which cause Excel close by itself.
Any kind of respond would be greatly appreciated.
Thank you in advanced.
Related
I have a set of data on a Userform in multiple textboxes.
I have written a code to find if there is a blank textbox left which would make the data sheet incomplete.
If the data is incomplete I want it to take my batch number (which is in Txtbox10A10) and put the batch number in my listbox so that I can access it later to complete the data.
Is there any way I can accomplish this? I have tried multiple ways with many errors.
hi sorry still new at vba
i have the following set of code
enter code here
Dim i As Integer
Dim J As Integer
Dim uppercolJ As Integer
Dim Mistakes As Integer
Dim x As Integer
' cmas = UserForm3.MultiPage1.Pages(UserForm3.MultiPage1.Value).Controls("Txtbox" & 1 & "A" & J)
Set Form = UserForm3.MultiPage1.Pages(UserForm3.MultiPage1.Value)
uppercolJ = 41
Mistakes = 0
For J = 28 To uppercolJ
ActiveTextBoxName = "Txtbox" & 1 & "A" & J
If UserForm3.MultiPage1.Pages(3).Controls(ActiveTextBoxName) = "" Then
Mistakes = Mistakes + 1
Else
End If
Next J
If Mistakes > 0 Then
MsgBox "Cells are incomplete, saving for later completion"
Else
MsgBox "comp"
'Call save
End If
End Sub`````
now when Mistakes > 0
then i would like it to save the batch no. of the product which can be found in Txtbox10A10
to a listbox i have created. so that if i come back tomorroww to finish all my data i can call that information from the batch no. in my listbox,
i have all coding already done just not sure how to get it to add my backnumber to the listbox upon Mistakes > 0
I want to produce a mini report of several items matching a key. In my loop I get the keys returned but can't fathom out how I can access the data that I need in the report that is held in other columns.
I put in some msgbox's to trap the data and an escape mechanism to get out of the loop. These I have commented out below as well as the data lines that don't work. "cbdata" is a workbook named range covering B5:T4019. The report is being compiled on a different sheet (activesheet). For some unknown reason on looping through without outputing any data "r" gets updated to some spurious numbers like 2421 (first loop) this appears to be linked somehow to the data in "cbdata". The first entry is actually in row 2388 so it doesn't really correlate to an indexed row in the range. However, I think first of all I need to find out what I can do to get the corresponding row returned for each of my passes. "ky" returns all the entries in columns(19) but I'm only interested in those that match "ledcdeyr" which in this instance is "2012017" that bit works returning all the entries matching in the loop.
Having got the key information agreeing, how might I relate this to the row number so that I can extract the other data from that row.
(cr is vbcrlf)(r should be the row number of the receiving report)
Any pointers would be greatly appreciated.
Code:
r = r + 1 ' row 38 when entering process
For Each ky In Range("cbdata").Columns(19).Cells
'ans = MsgBox(ky & cr & r, vbOKCancel)
'If ans = vbCancel Then Exit Sub
If ky = ledcdeyr Then
ans = MsgBox(ky & cr & r, vbOKCancel)
If ans = vbCancel Then Exit Sub
Cells(r, 2) = Range("cbdata").Cells(ky, 1)
'Cells(r, 3) = Range("cbdata").Columns(2).Cells
'Cells(r, 4) = Range("cbdata").Columns(3).Cells
'Cells(r, 5) = Range("cbdata").Columns(4).Cells
'Cells(r, 6) = Range("cbdata").Columns(5).Cells
ans = MsgBox(r, vbOKCancel + vbQuestion, title)
If ans = vbCancel Then Exit Sub
End If
r = r + 1
Next
I am not entirely sure I follow but the Range object during the loop is ky. The row for that cell be retrieved with .Row property
ky.Row
Somewhat random example with a conditional test:
Option Explicit
Public Sub Test()
Dim ky As Range, counter As Long
Dim loopRange As Range
Set loopRange = ThisWorkbook.Worksheets("Sheet1").Range("cbdata").Columns(19)
For Each ky In loopRange.Cells
counter = counter + 1
If ky = 1 Then
Debug.Print ky.Row, counter
Debug.Print loopRange(counter).Address
End If
Next
End Sub
I ran the undernoted slightly amended code on my project but it produced some spurious results.
I had already tried the ky.row but when it didn't give me the information, I just thought that it wasn't the answer.
Public Sub Test()
Dim ky As Range, counter As Long
Dim loopRange As Range
'Set loopRange = ThisWorkbook.Worksheets("Sheet1").Range("cbdata").Columns(19)
Set loopRange = Range("cbdata").Columns(19) ' workbook range name
For Each ky In loopRange.Cells
counter = counter + 1
'ans = MsgBox(counter & vbCrLf & ky & vbCrLf & ky.Row, vbOKCancel)
'If ans = vbCancel Then Exit Sub
If ky = 2012017 Then
Debug.Print ky.Row, counter
Debug.Print loopRange(counter).Address
End If
Next
End Sub
The Debug results from running the above code for the first 4 records were:
2388 2384
$CNK$5:$CNK$4091
2408 2404
$COE$5:$COE$4091
2444 2440
$CPO$5:$CPO$4091
2450 2446
$CPU$5:$CPU$4091
The numbers on the left produced by ky.row are correct. The numbers on the right relate somehow to the counter which here should be 1, 2, 3, 4. This is the same situation that occurred with my "r" and hence didn't produce the information where I expected to see it. Which caused me to think that ky.row was not working. Also my range "cbdata" is B5:T4091 The rows are correct but the "CNK" etc - I don't know where that has come from.
I thought I'd just feed back to you where I'm at and your reply certainly made me look further, as I seemed to be going round in circles.
If you have any idea how the counter would be acting so spuriously then perhaps you could let me know. Having used your code on its own the that clears up any issue with there not being a problem with any other part of my code. Thanks again.
I am writing a VBA code to go through a specified range or ranges, look for a keyword provided by the user at run-time, and grab the value in the cell offset from the cell with the keyword by an amount also provided by the user. For instance, if you wanted to look through A1:B10 for the word "Apple" and then grab the value in the cell to the right of every instance of "Apple", it can do that. Two weird things have been occurring for me. First and not so weird, when I run it and click the cancel button on the userform that only contains the single line "Unload Me", it throws an error saying it expected and End Sub statement, but it has one. I don't know why it is doing that. Weird thing number 2. Whenever I click and move the cursor to the end of the file after the Cancel_Click() sub, my excel crashes and closes. Every. Single. Time. And it is weird that it does that just from me clicking. It also sometimes happens when I click around the Cancel_Click() sub or hit enter around there too. Just simply from clicking. I don't get it. Any ideas? Code contained in the userform is below. Fyi, the user can input ranges like "A1:A10,E1:E10" separated by commas for multiple ranges. I don't think it is important for this question, but I thought I would add that since i don't know how to add the userform here, if you even can.
Private Sub Accept_Click()
'Searches for string input into the KeywordBox
'Grabs contents of the cell defined by the OffsetBox
'The range it searches through is defined by the RangeBox
Dim rawRange As String: rawRange = Me.RangeBox.Text
Dim rawOffset As String: rawOffset = Me.OffsetBox.Text
Dim Keyword As String: Keyword = Me.KeywordBox.Text
Dim numOfRanges As Integer: numOfRanges = 1
Dim Ranges() As Range
Dim commaLoc As Integer: commaLoc = -1
Dim tempRange As String: tempRange = rawRange
Dim offset As Integer
Dim values() As Double
Dim valCount As Integer: valCount = 0
'--------------------------------------------------------
'Set ranges
For i = 1 To Len(rawRange)
If (Mid(rawRange, i, 1) = ",") Then
numOfRanges = numOfRanges + 1
End If
Next
ReDim Ranges(numOfRanges) As Range
If (Not numOfRanges = 1) Then
For i = 1 To numOfRanges - 1
commaLoc = InStr(1, tempRange, ",")
Set Ranges(i) = Range(Left(tempRange, commaLoc - 1))
tempRange = Right(tempRange, Len(tempRange) - commaLoc)
Next
End If
Set Ranges(numOfRanges) = Range(tempRange)
'---------------------------------------------------------
'Set offset
If (IsNumeric(rawOffset)) Then
offset = CInt(rawOffset)
Else:
MsgBox ("Offset was not input as a number")
Exit Sub
End If
'----------------------------------------------------------
'Searches for keyword
For i = 1 To numOfRanges
For Each cell In Ranges(i)
If (cell.Value = Keyword) Then
valCount = valCount + 1
End If
Next
Next
ReDim values(valCount) As Double
valCount = 0
For i = 1 To numOfRanges
For Each cell In Ranges(i)
If (cell.Value = Keyword) Then
valCount = valCount + 1
values(valCount) = cell.offset(0, offset).Value
End If
Next
Next
For i = 1 To valCount
Range("I" & i).Value = values(i)
Next
Unload Me
End Sub
I've had similar, weird things happen to me. A good thing to try is to force the VBA project to reset, then save, exit, and restart Excel.
To force a project reset, add an Enum to the general section of one of your code modules. It doesn't matter what the enum is...make it something simple, like
Enum stoplight
Red
Yellow
Green
End Enum
As you do that, you'll get a message saying that it will reset your project. That's fine; let that happen. Then save your Excel workbook, exit excel completely, start it up again, reload your workbook, go into the VBA Editor, and delete the enum you added. Then recompile and see if things work better for you.
You put an "Exit Sub" in the set offset, this is probably causing your problem.
I was able to fix the issue by making a new workbook and copying everything over. It worked fine. I think the original was corrupted somehow. For those having the same issue, I think Rich Holton's answer would be worth a try in case you have more than just a few things to copy. Thanks everyone for you time and input on this!
Hope you're doing well. I'm going to preface this by saying I'm not a programmer and I'm sure the code I have started is riddled with more errors then what I think. Hopefully you can help :D.
I have an Excel sheet that gets generated from another program that comes out like this:
excel sheet
However, the size of this sheet can change with every new generation of this sheet from the other program. (ex, A can have 7 next time, and D could have 9) And the sheet as it is cannot be used easily to do the math required as I only need specific groups of information at a given time, in this example groups B and D only.
What I'm hoping to create is something that will take the sheet as its generated, and turn it into something that looks like this:
result sheet
This is the code I've written so far, but since I don't really know what I'm doing I keep running into numerous problems. Any help would be appreciated.
Option Explicit
Sub Numbers()
Dim matchesFound As Integer
Dim row As Integer
Dim c As Integer
Dim copyRow As Integer
Dim copyLocationColumn As Integer
Dim arr(2) As String
arr(0) = "1"
arr(1) = "2"
arr(2) = "3"
Function arrayContainsValue(array, varValue)
found = false
for each = 0 to array
if array(i) = varValue then
found = true
exit for
arrayContainsValue = found
End Function
row = 1
c = 1
copyLocationColumn = 1
copyRow = 1
matchesFound = 0
Do While matchesFound < 3
if arrayContainsValue(arr, ThisWorkbook.Sheets("Data").Cell(column,row))
matchesFound = matchesFound + 1
Do While ThisWorkbook.Sheets("Data").Cell(column, row)
ThisWorkbook.Sheets("postHere").Cell(copyLocationColumn, copyRow) = _
ThisWorkbook.Sheets("postHere").Cell(c + 1, row)
copyRow = copyRow+1
row = row + 1
Loop
End If
row = row + 1
Loop
End Sub
There are many logic errors to numerate in a comment, Excel highlights them automatically I'll do a summary explaining them:
1. Function can't be "in the middle" of the sub, finish the Sub (take the Function from the sub and paste until it says end sub.
2.array is a forbidden name, try with another variable name
3.For each =0 ? to array? what do you try to mean like that? For Each has to be element in something For each element in Array for example For and To are for something defined in numbers (for counter=1 to 15)
Function arrayContainsValue(***array***, varValue) '2nd problem
found = false
for each = 0 to array '3rd problem
if array(i) = varValue then
found = true
exit for
arrayContainsValue = found
End Function
....
4. you're missing a then at the end
if arrayContainsValue(arr, ThisWorkbook.Sheets("Data").Cell(column,row))
I don't get the coding logic on how relates to the problem stated (?)
Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub