I have an excel sheet with data arranged randomly with numbers and letters throughout Columns B and C. I also have an input cell located in cell "O7" and an output cell located in "P7" where a user can input any value (1,1a, 2,2b, etc...) and the code will use these values to find and copy the value in A
My code (below) runs through and finds the value in B based on the value in "O7" and copies the corresponding value in column A (2 times) for that row to "Sheet4." It then looks to the next cell in column C and uses that value to find the next row in Column B with that value. Then it copies that row's value in Column A to Sheet 4 under the previous one.
My problem is that my code can't distinguish between "1" and a value with a letter like "1a" for either the input or output value. It just sees that there is a "1" and copies the value in A. I believe I may not be setting my NewStart variable as the next value to look up correctly or my function may be missing something to distinguish between "1" and "1a"?
Sub NewerFind()
Dim Startval As Long
Dim Endval As Long
Dim LastRow As Long
Dim Rng As range
Dim Output As Long
Dim NewStart As Long
Dim Val As Long
Dim Valnew As Long
LastRow = Sheets("Sheet3").range("B" & Rows.Count).End(xlUp).Row
Startval = GetSingleFromString(Sheets("Sheet3").Cells(7, "O").Value)
Output = 2
NewStart = Startval
For X = 7 To LastRow
Val = GetSingleFromString(Sheets("Sheet3").Cells(X, 2).Value) 'if i set the variables equal to a string, do i need the GetSingleFromString function?
Valnew = GetSingleFromString(Sheets("Sheet3").Cells(X, 3).Value)
Endval = GetSingleFromString(Worksheets("Sheet3").Cells(7, "P").Value)
If Val = Endval Then
Exit Sub
ElseIf Val = NewStart Then
Sheets("Sheet4").Cells(Output, 1).Value = _
Sheets("Sheet3").Cells(X, 1).Value
Output = Output + 1
Sheets("Sheet4").Cells(Output, 1).Value = _
Sheets("Sheet3").Cells(X, 1).Value
Output = Output + 1
NewStart = Valnew
End If
'need line of code to set NewStart as the value of the cell to the right...???????
Next X
End Sub
This is the function I'm using to enable the code to include cells with letters. Without it, it skips cells with letters:
Private Function GetSingleFromString(ByVal InString As String) As Single
If Len(InString) <= -1 Then
GetSingleFromString = -1
Exit Function
End If
Dim X As Long
Dim Temp1 As String
Dim Output As String
For X = 1 To Len(InString)
Temp1 = Mid(InString, X, 1)
If IsNumeric(Temp1) Or Temp1 = "." Then Output = Output & Temp1
Next
If Len(Output) > 0 Then
GetSingleFromString = CSng(Output)
Else
GetSingleFromString = -1
End If
End Function
This is my excel Sheet:
A B C D E
1 1 1a 78.15 77.68 (Row 7)
2 1a 2 77.18 76.92
3 2 3 76.92 76.63
4 3 4 76.13 75.78
5 4 4a 75.78 75.21
6 4a 5 75.11 74.87
7 5 5a 74.87 74.69
8 5a 6 73.94 73.6
9 6 6a 73.1 72.71
10 6a 6b 72.41 72.18
11 6b 10 72.18 71.6
12 10 11 71.3 70.89
13 11 12 70.89 69.83
14 12 13 69.83 68.68
15 13 14 68.68 67.68
16 14 15 67.63 66.46
17 15 16 66.01 64.84
18 16 16a 64.24 63.72
19 16a 16b 56.82 56.37
20 16b 16c 56.37 55.18
21 16c OUT 47.28 47.27
22 7 7a 83.12 76.07
23 7a 8 76.17 75.99
24 8 9 74.79 74.41
25 9 6 74.51 74 (Row 31)
Thank you in advance for the help.
It's not clear what you're trying to do; all I can see is that you want to find cells with a matching value, which may be the entire value, or just the numeric part of a value.
What I do know is that Range.Find isn't as useful as you think: it sometimes makes a string comparison if either the search value or the seek range is a string, and sometimes decides it's 'no match' if tries the numeric value 1 against the string "1", depending on the formatting in the cells.
It'll definitely treat "1" versus "1a" as 'no match', if you've set LookAt:=xlWhole, because you've specified that the whole of the value, each and every character, must match the search string exactly.
That's fine, most of the time, if you wanted to treat "1" versus "1a" as 'no match', and only match "1"to "1" and "1a to "1a".
If you wanted to treat "1" versus "1a" as a 'find', you have two choices:
Use the partial match option in Range.Find by setting
LookAt:=xlPart, and hope that it doesn't get confused by formatting. And most of the time, it doesn't get confused; so you're probably fine.
Search through the cells in each range with VBA, using 'Like', which allows you to specify partial matches, single digits, and match-from-the-list for specific characters like [1234567890]
Just to get you started with 'Like':
"1" = "1a" returns False
"1" LIKE "1a" returns False
"1" LIKE "1*" returns True, although this isn't a very useful thing to know
"1a" LIKE "#*" returns True, and this looks a bit more relevant because you've identified a value that starts with a number, and you can test that at the top of an If... Then block containing further logic to make the match you actually want.
Full documentation for the 'Like' operator is here on MSDN:
https://msdn.microsoft.com/en-us/library/office/gg251796.aspx
Developers using other languages will use Regular Expressions for this kind of thing: but you'd need to import an external Regex library for that, as it isn't native to Excel and VBA.
Also: a string can never have a LEN of less than zero. Your test If Len(InString) <= -1 Then needed to be for zero, or less than 1.
Related
in my data there are more than a thousand different six digit numbers that are reoccurring in no specific pattern. I need to find all six digit codes that exist in column A and for each number. For example 123456, then find summarize the value in column B for every row that has 123456 in column A. My code is not very effective but the runtime is not a problem if I run with only 10 rows. However, in the real data sheet there are 80 000 rows and my code will take to much time. Can someone help me edit my code but removing certain loops within loops or some stop conditions. I'm new to VBA and can't do it myself in the limited time I have.
Sub Test2()
Dim summa As Long
Dim x As Long
Dim condition As Boolean
Dim lRows As Long
Dim k1 As Integer
Dim i As Long
x = 1
Worksheets("Sheet1").Activate
For i = 100000 To 999999
k1 = 1
lRows = 10
condition = False
While k1 <= lRows
If Cells(k1, "A").Value = i Then
condition = True
End If
k1 = k1 + 1
Wend
If condition = True Then
Cells(x, "F").Value = Application.SumIf(Range("A:A"), CStr(i), Range("B:B"))
Cells(x, "E").Value = i
x = x + 1
End If
Next i
MsgBox "Done"
End Sub
You don't need VBA for this task. Follow these steps.
Insert a blank column C in a copy of the original data sheet.
Insert a SUMIF formula, like =SUMIF(A:A, A2, B:B) in C2 and copy all the way down.
Now all items 123456 will have the same total in column C
Copy column C and Paste Values (to replace the formulas with their values).
Delete column B.
Remove duplicates.
I have an excel sheet containing entities, their characteristics, a value for the characteristic and a total as follows:
Entity CHAR1 CHAR2 CHAR3 CHAR4 Total
1 10 20 5 5 40
2 5 100 30 25 160
3 25 25 10 20 80
Now I want to replace the values with percentages in which the total column is seen as 100% for each row seperately.
This would in this example result in:
Entity CHAR1 CHAR2 CHAR3 CHAR4
1 25 50 12,5 12,5
2 3,125 62,5 18,75 15,625
3 31,25 31,25 12,5 25
As my data-set is pretty big i'm wondering if there is a fast solution to do this? I get stuck because placing a formula in each cell will require calculating the new value using the old value in the cell itself. And using a new worksheet might give me some performance issues.
Thanks in advance
Run this sub and all should work as you asked (note that you need to define the TotalColumn column number (since it isn't evident in the example)
Sub MakePercent()
Dim Cell As Range, CalcRange As Range, TotalColumn As Variant
TotalColumn = 'Write the column number or letter here
Set CalcRange = ActiveSheet.Range(ActiveSheet.Cells(2,2), ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count,TotalColumn - 1))
For Each Cell In CalcRange
Cell.Value = CDbl(Cell.Value) / CDbl(ActiveSheet.Cells(Cell.Row,totalColumn))
Next Cell
End Sub
Minor update from myself:
The macro as provided by RGA worked fine, until I expanded my data with some extra columns. It then caused excel to freeze and therefore i went looking for a new solution.
If found the following stackoverflow question and adding Application.ScreenUpdating = false to the beginning and Application.ScreenUpdating = true to the end of the macro resolved the freezing issue.
This leads to the following code:
Sub MakePercent()
Application.ScreenUpdating = False
Dim Cell As Range, CalcRange As Range, TotalColumn As Variant
TotalColumn = 'Write the column number or letter here
Set CalcRange = ActiveSheet.Range(ActiveSheet.Cells(2,2), ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count,TotalColumn - 1))
For Each Cell In CalcRange
Cell.Value = CDbl(Cell.Value) / CDbl(ActiveSheet.Cells(Cell.Row,totalColumn))
Next Cell
Application.ScreenUpdating = True
End Sub
As a complete beginner to VBA Excel, I would like to be able to do the following:
I want to find the first value larger than 0 in a row, and then sum over the following 4 cells in the same row. So
Animal1 0 0 1 2 3 0 1
Animal2 3 3 0 1 4 2 0
Animal3 0 0 0 0 0 1 0
Results in
Animal1 7
Animal2 11
Animal3 1
Is this possible?
(Your problem description didn't match your examples. I interpreted the problem as one of summing the 4 elements in a row which begin with the first number which is greater than 0. If my interpretation is wrong -- the following code would need to be tweaked.)
You could do it with a user-defined function (i.e. a UDF -- a VBA function designed to be used as a spreadsheet function):
Function SumAfter(R As Range, n As Long) As Variant
'Sums the (at most) n elements beginning with the first occurence of
'a strictly positive number in the range R,
'which is assumed to be 1-dimensional.
'If all numbers are zero or negative -- returns a #VALUE! error
Dim i As Long, j As Long, m As Long
Dim total As Variant
m = R.Cells.Count
For i = 1 To m
If R.Cells(i).Value > 0 Then
For j = i To Application.Min(m, i + n - 1)
total = total + R.Cells(j)
Next j
SumAfter = total
Exit Function
End If
Next i
'error condition if you reach here
SumAfter = CVErr(xlErrValue)
End Function
If your sample data is in A1:H3 then putting the formula =SumAfter(B1:H1,4) in I1 and copying down will work as intended. Note that the code is slightly more general than your problem description. If you are going to use VBA, you might as well make your subs/functions as flexible as possible. Also note that if you are writing a UDF, it is a good idea to think of what type of error you want to return if the input violates expectations. See this for an excellent discussion (from Chip Pearson's site - which is an excellent resource for Excel VBA programmers).
ON EDIT: If you want the first cell greater than 0 added to the next 4 (for a total of 5 cells in the sum) then the function I gave works as is, but using =SumAfter(B1:H1,5) instead of =SumAfter(B1:H1,4).
This is the one of the variants of how you can achieve required result:
Sub test()
Dim cl As Range, cl2 As Range, k, Dic As Object, i%: i = 1
Set Dic = CreateObject("Scripting.Dictionary")
For Each cl In ActiveSheet.UsedRange.Columns(1).Cells
For Each cl2 In Range(Cells(cl.Row, 2), Cells(cl.Row, 8))
If cl2.Value2 > 0 Then
Dic.Add i, cl.Value2 & "|" & Application.Sum(Range(cl2, cl2.Offset(, 4)))
i = i + 1
Exit For
End If
Next cl2, cl
Workbooks.Add: i = 1
For Each k In Dic
Cells(i, "A").Value2 = Split(Dic(k), "|")(0)
Cells(i, "b").Value2 = CDec(Split(Dic(k), "|")(1))
i = i + 1
Next k
End Sub
Here is what I would use, I dont know any of the cell placement you have used so you will need to change that yourself.
Future reference this isnt a code writing site for you, if you are new to VBA i suggest doing simple stuff first, make a message box appear, use code to move to different cells, try a few if statments and/or loops. When your comftable with that start using varibles(Booleans, string , intergers and such) and you will see how far you can go. As i like to say , "if you can do it in excel, code can do it better"
If the code doesnt work or doesnt suit your needs then change it so it does, it worked for me when i used it but im not you nor do i have your spread sheet
paste it into your vba and use F8 to go through it step by step see how it works and if you want to use it.
Sub test()
[A1].Select ' assuming it starts in column A1
'loops till it reachs the end of the cells or till it hits a blank cell
Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
'adds up the value of the cells going right and removes the previous cell to clean up
Do Until ActiveCell.Value = ""
x = x + ActiveCell.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, -1).ClearContents
Loop
'goes back to the begining and ends tallyed up value
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Value = x
'moves down one to next row
ActiveCell.Offset(1, 0).Select
Loop
End Sub
I have a spreadsheet which I am cleaning and using macros to help. My column 'C' has temperature data. Like with all data, there is some missing. How would I write a macro that would auto-fill the missing spot with previous data?
For example:
C C
1 37 1 37
2 35 2 35
3 --------> 3 35
4 37 4 37
5 36 5 36
The spot C3 has been filled with C2's data.
Thank you for your help.
Do you really need VBA for this?
Do this
Select Col C
Press Ctrl + G
Click on Special
Next Click on Blanks
Click Ok
All Empty cells are now selected. Press the = key and then the Up arrow key
Lastly press Ctrl+Tab+Enter and you are done.
ScreenShot
Give this a try:
Sub FixC()
Dim N As Long, i As Long
N = Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To N
If Cells(i, "C") = "" Then
Cells(i, "C") = Cells(i - 1, "C")
End If
Next i
End Sub
How would I write that macro:
This contains only snippets.
loop over all cells in the column:
for each cell in ActiveSheet.Columns(1).Cells
if the cell value is not empty -> save the value to a variable
If cell.value <> Empty then lastCellValue = cell.value
if the cell value is empty -> write the saved cell value into the cell
Else cell.value = lastCellValue
also:
if more than x (e.g. 20) cells in a row were empty, break from loop
I have a Excel matrix as below:
PID# T1 T2 T3 T4 T5 T6 T7
11 1 1
14 1 1 1
21 1 1
41 1 1 1 1
71 1
88 1 1 1
PID# is nothing but the processes, all the processes has been composed of multiple tasks. But it is not mandatory that all processes should use all the T1 - T5 tasks. In such a scenario is it possible to get the PID# which used maximum tasks. 1 used to indicate that a task has been used or not. here the PID# 41 and 88 used maximum tasks say it is 5. I need only the maximum used column count and any of the row# which used that number of columns.
NOTE
here i have used 1 to tell there is data,but in reality there are different types of data. I need to find out which row used maximum columns.But one thing if any cells for a row is blank and it is to the left,should be in the count. say for example --
<> 1 <> 1 gives the count as 4
<> <> 1 <> will give the count as 3
1 1 <> will give the count as 2 ' here I used <> used to represent the no values
EDIT
Option Explicit
Dim ArrayListTaskDetails : Set ArrayListTaskDetails = CreateObject("System.Collections.ArrayList")
Dim i,colcount
i=2
Do while i < = objExcel1.Application.WorksheetFunction.CountA(ob.Rows(1))
colcount=objExcel1.Application.WorksheetFunction.CountA(ob.Rows(i))
ArrayListTaskDetails.Add(colcount)
i=i+1
Loop
ArrayListTaskDetails.Sort()
i=ArrayListTaskDetails.Count
MsgBox("HighestColumnNumner:" & ArrayListTaskDetails(i-1))
Problem:
I can't count the blank columns for rows which don't have the contiguous value. Thus count is not produced by me correctly.
EDIT1
Here the problem is still i can't count the left blank cells if any,as those are also to be considered as used column,in which other rows can have values.Thus need to find out the the right most column which has been used by a row after which no columns has been used by any rows. Hope I am able to clear what I am looking for:
Option Explicit
Dim objExcel1
Dim strPathExcel1
Dim objSheet1,objWB,ColCount
Dim ArrayListTaskDetails : Set ArrayListTaskDetails = CreateObject("System.Collections.ArrayList")
Set objExcel1 = CreateObject("Excel.Application")
strPathExcel1 = "D:\AravoVB\.xlsx"
Set objWB = objExcel1.Workbooks.open(strPathExcel1)
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
Do Untill count > objExcel1.Application.WorksheetFunction.CountA(objSheet1.Rows(1))
Range = objSheet1.("count:count")
ColCount=objExcel1.Application.WorksheetFunction.CountIf(Range,<> "")
ArrayListTaskDetails.Add(ColCount)
Loop
ArrayListTaskDetails.Sort()
MsgBox(ArrayListTaskDetails(ArrayListTaskDetails.Count - 1))
Thanks,
Still not convinced why Vikas answer is not working for you. Try this code please. It highlights the last max value. Only flaw is that it doesn't track all the PID that has same max value. I could improve the code if you need that as well.
Code:
Option Explicit
Sub getRealUsedColumns()
Dim rngInput As Range
Dim arrInput As Variant, arrRowTotal As Variant
Dim i As Integer, j As Integer, counter As Integer, iTemp As Integer
Dim iPID As Integer, maxRowNum As Integer
arrInput = Application.WorksheetFunction.Transpose(Sheets(3).Range("B3:I8").Value2)
ReDim arrRowTotal(LBound(arrInput, 2) To UBound(arrInput, 2))
For i = LBound(arrInput, 2) To UBound(arrInput, 2)
counter = 0
For j = LBound(arrInput) + 1 To UBound(arrInput)
If arrInput(j, i) <> "" Or Not IsEmpty(arrInput(j, i)) Then
counter = counter + 1
End If
Next j
'-- most recent max value (if you have two of the same, this doens't catch)
'-- you need to save in a proper array to catch multiple PIDs with same max value
If iTemp <= counter Then
iTemp = counter
iPID = arrInput(1, i)
maxRowNum = i
End If
arrRowTotal(i) = counter
Next i
'-- Row total into the sheet output
Sheets(3).Range("J3").Resize(UBound(arrRowTotal)) = _
Application.WorksheetFunction.Transpose(arrRowTotal)
'-- highlight the max total row.
With Sheets(3).Range("B3").Offset(maxRowNum - 1, 0).Resize(1, UBound(arrInput, 1) + 1)
.Interior.Color = 200
End With
End Sub
Results:
Excel is very powerful in calculating Matrix. I would use the Excel Formula instead of Code in order to calculate it. I would add a column in the right, which would add the total number of tasks used by a process, as shown in the matrix below.
A B C D E F G
1 PID T1 T2 T3 T4 T5 Total
2 #11 1 1
3 #14 1 1 1 3
4 #21 1 1 1 1 1 5
5 #41 1 1 2
Then I will write two Array Formulas to calculate the maximum number of tasks used by a process and the name of that process.
Formula to calculate maximum tasks used in the example: =SUM(IF($G$2:$G$5=MAX($G$2:$G$5),G2:G5,0))
Formula to find the pricess which used the maximum tasks:
=OFFSET(A1,SUM(IF($G$2:$G$5=MAX($G$2:$G$5),ROW(G2:G5)-1,0)),0,1,1)
Please note that I had mentioned that I used Array formulas. In order to add array formula in Excel, you need to enter formula and then press "Ctrl+Shift+Enter" to make that formula an array formula.
Hope this helps.
Vikas B
-----------------EDIT-----------------------------------------------------
Adding the code here. I just used the sample, as show in matrix and produced the correct result.
Sub FindMax()
'assuming column 1 is the task ID and Row one has the headings.
Const LastColumn As Integer = 7 ' you can use xl end to get the last used column in the range
Const LastRow As Integer = 5
Dim rowCounter As Integer
Dim prevValue As Integer
Dim rngToTotal As Range
Dim sht As Worksheet
Dim maxRowName As String
Dim value As Integer
Dim maxValue As Integer
Set sht = ActiveSheet
For rowCounter = 2 To LastRow
Set rngToTotal = sht.Range(sht.Cells(rowCounter, 2), sht.Cells(rowCounter, LastColumn))
value = WorksheetFunction.Sum(rngToTotal)
If value > prevValue Then
maxRowName = sht.Cells(rowCounter, 1).value
maxValue = value
End If
prevValue = value
Next rowCounter
MsgBox "Process name " & maxRowName & " = " & maxValue
End Sub