Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 5 years ago.
Improve this question
I have a column in my excel in the following format:
Column A
1.2kg
100ml
2m
200
I need to run the VBA to split the numbers and text separately into two columns as:
Column A | Column B
1.2 | kg
100 | ml
2 | m
200 |
I've also found a similar question in this site, however it isn't work for my VBA. Can anyone help me on this?
PS. I use excel 2007
Untested as am on mobile. Does it do what you want?
Option Explicit
Sub SplitValuesUnits()
' Code assumes values are on Sheet1. Change sheet name as needed.'
With thisworkbook.worksheets("Sheet1")
Dim LastRow as long
LastRow = .cells(.rows.count,"A").end(xlup).row
With .range("A1:B" & LastRow)
Dim ArrayOfValues() as variant
ArrayOfValues = .value2
Dim CharacterIndex as long
Dim RowIndex as long
For RowIndex = lbound(ArrayOfValues,1) to ubound(ArrayOfValues,1)
' Skip zero-length strings, as well as values which are already numbers and do not need splitting '
If len(ArrayOfValues(RowIndex,1)) <> 0 then
If not isnumeric(ArrayOfValues(RowIndex,1)) then
Dim CurrentValue as string
CurrentValue = ArrayOfValues(RowIndex,1)
' Loop through string backwards until we find a numeric value, at which point we assume there are no further non-numeric characters. '
For CharacterIndex = Len(CurrentValue) to 1 Step -1
If isnumeric(mid$(CurrentValue),CharacterIndex,1)) then exit for
Next CharacterIndex
If CharacterIndex >= 1 then
ArrayOfValues(RowIndex,1) = cdbl(left$(CurrentValue,CharacterIndex))
ArrayOfValues(RowIndex,2) = mid$(CurrentValue,CharacterIndex + 1)
End if
End if
End if
Next RowIndex
' Overwrite two columns with values. '
.value2 = arrayofvalues
End with
End with
End sub
Related
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
I need to write a macro that searches a specified column and counts all the cells that contain a specified string, such as character "p" and character "q" then associate this in another column i.e the total column, indicating the character which has occurred maximum number of times in the corresponding row
Have attached a sample screen shot of the same.
Does anyone have any ideas?
Thank you in advance.
Based on your additional criteria of having to exclude certain columns in the row I think it may indeed be easier to use VBA and create a user defined function that you can then enter into the cells in your spreadsheet in the same way as any other function.
I've shown my attempt below which basically checks the column of each cell in the range to ensure it has a header of "Symbol" and if so adds the value of that cell to an Array (after being converted to a number value). There is then another function that gets the mode from that array (this only works on numeric values which is why it was converted in the previous step). Finally that is converted back to a letter.
It's quite a roundabout way and there may be an easier approach but hopefully this will work for now and give you some idea's of how to create these kind of functions for yourself.
Create a new module in your VBA project and copy all 4 of the below procedures into it:
Option Explicit
Public Function MostFrequentValue(RNG As Range) As String
Dim HeaderRow As Integer
Dim a As Range
Dim arr As Variant
HeaderRow = 1 'Change this to whatever row your headers are in
For Each a In RNG.Cells
If Cells(HeaderRow, a.Column) = "Symbol" Then
If IsEmpty(arr) Then
arr = Array(ConvertLetterToNumber(a.Value))
Else
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = ConvertLetterToNumber(a.Value)
End If
End If
Next
MostFrequentValue = ConvertNumberToLetter(ArrayMode(arr))
End Function
.
Function ConvertNumberToLetter(ByVal strSource As Integer) As String
ConvertNumberToLetter = LCase(Chr(strSource + 64))
End Function
.
Function ConvertLetterToNumber(ByVal strSource As String) As Integer
Dim i As Integer
Dim strResult As String
strSource = UCase(strSource)
For i = 1 To Len(strSource)
Select Case Asc(Mid(strSource, i, 1))
Case 65 To 90:
strResult = strResult & Asc(Mid(strSource, i, 1)) - 64
Case Else
strResult = strResult & Mid(strSource, i, 1)
End Select
Next
ConvertLetterToNumber = strResult
End Function
.
Function ArrayMode(Ray As Variant) As Integer
With Application
ArrayMode = .Mode(Ray)
End With
End Function
You would then enter the function into a cell like so =MostFrequentValue("A2:C2")
P.S. This assumes that the symbol in each value in the Symbol column is a lowercase letter of the alphabet (a-z). This appears to be the case from your example
You don't need a macro. The below formula will give you what you need. The range being counted appears in the formula 3 times. You would need to adjust this for the range you want to check
=INDEX(A1:C1,MODE(MATCH(A1:C1,A1:C1,0)))
Note: this will return an error if no single character appears more times than any other. In this case you could wrap the above formula in an IFERROR function to return whatever value you would want to see when this happens.
If you have any blank cells in the row, you can use the following array formula, which adds an IF statement to test for empty cells:
=INDEX(A1:C1,MODE(IF(A1:C1<>"",MATCH(A1:C1,A1:C1,0))))
When entering this formula you will need to press Ctrl + Shift + Enter
This question already has answers here:
workaround named range character limit
(3 answers)
Closed 5 years ago.
Suppose you have an array of numbers, and they are the column numbers that you would like to delete. A smart idea is to convert them to letters and then concatenate them and delete all the columns, as shown here by #Siddharth Rout. But there is a problem, it seems there is an upper limit of string inside range, so say
str = "AB:AB,CJ:CJ,CZ:CZ,NJ:NJ,NK:NK,NL:NL...",
Len(str)=300, 'Just about 50 columns, not too many indeed, there are 16384 columns in Excel 2010!!!
Chances are you will get an error if you use Range(str).Delete Shift:=xlToLeft, how to solve this problem?
Another option
Option Explicit
Public Sub DeleteColumns()
Dim i As Long, arr As Variant
arr = Split("3-5-7", "-") 'ascending order
Application.ScreenUpdating = False
With Sheet1
For i = UBound(arr) + 1 To LBound(arr) + 1 Step -1
.Cells(Val(arr(i - 1))).EntireColumn.Delete
Next
End With
Application.ScreenUpdating = True
End Sub
(slow for a large number of columns)
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Closed 8 years ago.
This question appears to be off-topic because it lacks sufficient information to diagnose the problem. Describe your problem in more detail or include a minimal example in the question itself.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Improve this question
Let me give you a basic understanding of my what I'm trying to do. I have two workbooks: Master Workbook and Workbook A. Information in Workbook A will be inputted into the Master Workbook. In Workbook A, there is Column X with numbers between the ranges of 1 to 25. All I care about are values greater than 14.
Problem: How do I create a VBA function that looks at Column X (Row 1) to see if it is greater than 14? If it is then it copies the entire row and pastes it into the Master Workbook, else it moves onto Column X2. Also, after copying row 1 and pasting into Master Workbook, I also need it to go back to Workbook A and check the rest of Column X if it is greater 14.
Thank you so much in advance!
This code should do what you want:
Private Sub checkAndCopy()
Dim i As Integer
Dim lastRow As Integer
Dim foundItem As String
Dim j As Integer
Dim pasteTo As Range
Dim k As Integer
k = 0
lastRow = WorksheetFunction.CountA(Range("A:A"))
For i = 1 To lastRow
If Cells(i, 24).Value > 14 Then
k = k + 1
For j = 1 To 24
foundItem = Cells(i, j).Value
Set pasteTo = Workbook(yourWorkbook).Cells(k, j)
pasteTo.Value = foundItem
Next j
End If
Next i
End Sub
Note that it copies into the new workbook starting on Row 1. You can have it search for the next empty line and add to that by including:
k = Workbook(yourWorkbook).WorksheetFunction.CountA(Range("A:A")) + 1
I hope this helps!
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Closed 9 years ago.
Improve this question
I am currently doing some data entry for a spreadsheet which contains hundreds on entries and want to automate the process, I have a good idea of what I want it to do but have little experience with Excel or VBA.
The idea behind it is that I have a code in one column and in the next column there is another code which is unique to the value in the former column. To give an example:
So for every cell that contains 123, the column next to it will be "ABC".
The sort of solution I would like is a macro that will work its way down Column A, storing the value of each cell (or something of that effect) and then working its way down to check for values that match that stored one. If a match is found, the macro will then copy the code from column B, the cell that is next to the stored cell and copy it into the cell in column B, next to the match.
EXAMPLE:
It will store the "123" value in A, work its way down Column A to find other cells matching "123" and when it finds them copy "ABC" into the column B cells next to the matches.
Hope this is easy to understand and someone can help me with coming up with a solution, would make this whole process alot easier as the spreadsheet is growing by the day and manual input is taking far to much time
Give this macro a try:
Sub FillInTheBlanks()
Dim rA As Range
Dim rB As Range
Dim r As Range, rr As Range
Dim N As Long
Dim va As Variant
N = Cells(Rows.Count, "A").End(xlUp).Row
Set rA = Range("A1:A" & N)
Set rB = rA.Offset(0, 1).Cells.SpecialCells(xlCellTypeBlanks)
If rB Is Nothing Then Exit Sub
For Each r In rB
va = r.Offset(0, -1).Value
For Each rr In rA
If rr.Value = va And rr.Offset(0, 1) <> "" Then
r.Value = rr.Offset(0, 1).Value
End If
Next rr
Next r
End Sub
It's difficult to tell what is being asked here. This question is ambiguous, vague, incomplete, overly broad, or rhetorical and cannot be reasonably answered in its current form. For help clarifying this question so that it can be reopened, visit the help center.
Closed 10 years ago.
I am a complete beginner in excel and got an assignment today to be completed by tomorrow . I would be really grateful if someone can help me out in this .
I have a sheet which has the following table :
The first table is the master , from which i need to get the data and represent it the form of separate tables using marco-VBA . Would appreciate any help to achieve this using macro .Thanks.
Say the master table has n columns , so I need to form n-1 separate tables where each table will have 2 columns the first column will always be the first column of the master table and the second column will be (n+1)th column from the master table for the nth table . Example - 1st table will have 2 columns (1st column of master table and 2nd column of master table ) , likewise 2nd table will have 2 columns (1st column of master table and 3rd column of master table ) , so on and so forth ....
I will be adding to this answer over the next hour or so. The idea is for you to start with the early blocks of code while I develop later blocks. Edit I have now completed the answer except for any extra explanations you might seek.
I agree with RBarryYoung: you do not provide enough information to allow anyone to provide you with a complete solution. Also, if you are trying to learn VBA, giving you the solution will not help in the long term.
I would normally agree with djphatic: the macro recorder is very useful for learning the VBA that matches user operations but the macro recorder will not give you much of the VBA you need for this task.
I am curious who has given you this assignment when you are clearly not ready for it.
I cannot read your image so I created a worksheet which I named "MasterTable" and loaded it with data so it looks like:
Your comments imply that this table may change in size so the first task is to identify its dimensions. There are many different ways of identifying the dimensions of a table; none of which work in every situation. I will use UsedRange.
Copy the following into a module:
Option Explicit
Sub SplitTable1()
Dim UsedRng As Range
With Worksheets("MasterTable")
Set UsedRng = .UsedRange
Debug.Print UsedRng.Address
Debug.Print UsedRng.Columns.Count
Debug.Print UsedRng.Rows.Count
End With
End Sub
There is no time to give full explanations of everything I will show you but I will try to explain the most important points.
Option Explicit means every variable must be declared. Without this statement, a misspelt name will automatically declare a new variable.
Debug.Print outputs values to the Immediate window which should be at the bottom of the VBA Editor screen. If it is not there, click Ctrl+G.
Dim UsedRng As Range declares a variable UsedRng of type Range. A range is a type of Object. When you assign a value to an object, you MUST start the statement with Set.
Running this macro will output the following to the Immediate window:
$A$1:$H$6
8
6
I will not be using UsedRng.Address or UsedRng.Columns.Count but I wanted you to understand what the UsedRange is and how it can be used.
Add this macro to the module:
Sub SplitTable2()
Dim CellValue() As Variant
Dim ColCrnt As Long
Dim RowCrnt As Long
With Worksheets("MasterTable")
CellValue = .UsedRange.Value
For RowCrnt = LBound(CellValue, 1) To UBound(CellValue, 1)
Debug.Print "Row " & RowCrnt & ":";
For ColCrnt = LBound(CellValue, 2) To UBound(CellValue, 2)
Debug.Print " " & CellValue(RowCrnt, ColCrnt);
Next
Debug.Print
Next
End With
End Sub
Dim CellValue() As Variant declares a dynamic array, CellValue, of type Variant. () means I will declare the size of the array at run time.
CellValue = .UsedRange.Value sets the array CellValue to the values within the UserRange. This statement sets the dimensions of CellValue as required.
CellValue becomes a two dimensional array. Normally the first dimension of an array would be the columns and the second the rows but this is not TRUE when the array is loaded from or to a range.
With a one dimensional array, LBound(MyArray) returns the lower bound of the array and UBound(MyArray) returns the upper bound.
With a two dimensional array, LBound(MyArray, 1) returns the lower bound of the first dimension of the array and LBound(MyArray, 2) returns the lower bound of the second dimension.
This macro outputs the following to the Immediate window.
Row 1: Column 1 Column 2 Column 3 Column 4 Column 5 Column 6 Column 7 Column 8
Row 2: R1C1 R1C2 R1C3 R1C4 R1C5 R1C6 R1C7 R1C8
Row 3: R2C1 R2C2 R2C3 R2C4 R2C5 R2C6 R2C7 R2C8
Row 4: R3C1 R3C2 R3C3 R3C4 R3C5 R3C6 R3C7 R3C8
Row 5: R4C1 R4C2 R4C3 R4C4 R4C5 R4C6 R4C7 R4C8
Row 6: R5C1 R5C2 R5C3 R5C4 R5C5 R5C6 R5C7 R5C8
This second macro demonstrates that I can load all the values from the worksheet into an array and then output them.
Add this macro to the module:
Sub SplitTable3()
Dim ColourBack As Long
Dim ColourFont As Long
With Worksheets("MasterTable")
ColourBack = .Range("A1").Interior.Color
ColourFont = .Range("A1").Font.Color
Debug.Print ColourBack
Debug.Print ColourFont
End With
End Sub
Run this macro and it will output:
16711680
16777215
For this answer, these are just magic numbers. 16777215 sets the font colour to white and 16711680 sets the background or interior colour to blue.
For the last macro, I have created another worksheet "SplitTables".
Add this macro to the module:
Sub SplitTable4()
Dim CellValue() As Variant
Dim ColDestCrnt As Long
Dim ColourBack As Long
Dim ColourFont As Long
Dim ColSrcCrnt As Long
Dim RowDestCrnt As Long
Dim RowDestStart As Long
Dim RowSrcCrnt As Long
With Worksheets("MasterTable")
' Load required values from worksheet MasterTable
CellValue = .UsedRange.Value
With .Cells(.UsedRange.Row, .UsedRange.Column)
' Save the values from the top left cell of the used range.
' This allows for the used range being in the middle of the worksheet.
ColourBack = .Interior.Color
ColourFont = .Font.Color
End With
End With
With Worksheets("SplitTables")
' Delete any existing contents of the worksheet
.Cells.EntireRow.Delete
' For this macro I need different variables for the source and destination
' columns. I do not need different variables for the source and destination
' rows but I have coded the macro as though I did. This would allow the
' UsedRange in worksheet "MasterTable" to be in the middle of the worksheet
' and would allow the destination range to be anywhere within worksheet
' "SpltTables".
' Specify the first row and column of the first sub table. You will
' probably want these both to be 1 for cell A1 but I want to show that my
' code will work if you want to start in the middle of the worksheet.
ColDestCrnt = 2
RowDestStart = 3
' I use LBound when I do not need to because I like to be absolutely
' explicit about what I am doing. An array loaded from a range will
' always have lower bounds of one.
For ColSrcCrnt = LBound(CellValue, 2) + 1 To UBound(CellValue, 2)
' Create one sub table from every column after the first.
'Duplicate the colours of the header row in worksheet "MasterTable"
With .Cells(RowDestStart, ColDestCrnt)
.Interior.Color = ColourBack
.Font.Color = ColourFont
End With
With .Cells(RowDestStart, ColDestCrnt + 1)
.Interior.Color = ColourBack
.Font.Color = ColourFont
End With
RowDestCrnt = RowDestStart
For RowSrcCrnt = LBound(CellValue, 1) To UBound(CellValue, 1)
' For each row in CellValue, copy the values from the first and current
' columns to the sub table within worksheet "SplitTables"
.Cells(RowDestCrnt, ColDestCrnt).Value = _
CellValue(RowSrcCrnt, LBound(CellValue, 2))
.Cells(RowDestCrnt, ColDestCrnt + 1).Value = _
CellValue(RowSrcCrnt, ColSrcCrnt)
RowDestCrnt = RowDestCrnt + 1
Next RowSrcCrnt
ColDestCrnt = ColDestCrnt + 3 ' Advance to position of next sub table
Next ColSrcCrnt
End With
End Sub
This is the real macro. All previous macros have served to demonstrate something. This macro does what I think you want.
Come back with questions. However, I do not know what time zone you are in. It is 23:00 here. I will be going to bed in about an hour. After that questions will be answered tomorrow.
Take a look at the macro recorder within Excel. What you are looking to achieve looks like using VBA to perform simple copy and pastes on specific columns within a table. If you turn the macro recorder on and produce the first table by copying and pasting the variable and estimate columns then hit stop, you can view the code producing by viewing the Visual Basic Editor (Ctrl+F11).
You may find these links of some use:
http://www.automateexcel.com/2004/08/18/excel_cut_copy_paste_from_a_macro/
http://www.techrepublic.com/blog/10things/10-ways-to-reference-excel-workbooks-and-sheets-using-vba/967