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 1 year ago.
Improve this question
Im working with a spreadsheet which I can't format the way I think it would be easier so I'm tryng to work around.
There's a table with the Employee names and the weekdays which I have to leave it blank if he is not working that day or fill in with his specific shift time. Basically, I want to display a message if the employee will work more than 4 days straight or if he has more than 48h already assigned on that week.
I can manage to display the message if the hours are above 48, but I can't manage the 4 days straight. I tried using FOR to go all over the cells but I can't formulate a counter.
I'm pretty sure there's an easier solution for that, better than using FOR but my knowledge on this is quite low.
Table
You could use an array formula to show the longest streak of consecutive days.
=MAX(FREQUENCY(IF(LEN(B2:H2)>0,COLUMN(B2:H2)),IF(LEN(B2:H2)>0,0,COLUMN(B2:H2))))
Enter that with Ctrl+Shift+Enter, not just Enter. You can compare the result of that formula to "4" and if it's greater, do whatever you want.
If you can't (or don't want to) add a formula, here's a VBA function that does the same thing.
Public Function MaxConsecutiveDays(ByRef rRng As Range) As Long
Dim rCell As Range
Dim lCnt As Long
Dim lMax As Long
For Each rCell In rRng.Cells
If IsEmpty(rCell.Value) Then
lCnt = 0
Else
lCnt = lCnt + 1
End If
If lCnt > lMax Then
lMax = lCnt
End If
Next rCell
MaxConsecutiveDays = lMax
End Function
Then you can use that in your code like
Public Sub test()
If MaxConsecutiveDays(Sheet1.Range("B2:H2")) > 4 Then
Err.Raise 9999, , "Too many days"
Else
MsgBox "OK"
End If
End Sub
All of this assumes that you if there is anything in a cell, it's 8 hours and that you don't have to concern yourself with parsing the hours string in the cell to determine how long they're scheduled for.
Related
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Closed 4 years ago.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
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.
Improve this question
I have just started to learn how to program using Python about a month ago and I am trying to learn a bit about VBA as well. I have an excel document with 3 sheets, the first being an inventory with columns A through W and several thousand rows. The second sheet is the assets that are in question, the third is the destination for the results.
This is the pseudo code for the macro:
Make the second sheet active
Create Loop to go through contents of column A and highlight each
Copy contents of each row to variable one by one
Make the first sheet active
Loop through the contents of Column C and D for aforementioned variable
If found highlight the active row
Copy active row to sheet 3 in next available row starting at A
I have researched how to solve this problem for the last several days, finding code for searching, looping through rows, selecting the appropriate row, going between sheets for the copy command. With all of this I have written what I believe should work for the intended purpose. I have included comments for each line to give my thought process behind it.
The error I'm receiving currently: Run-time error '9': Subscript out of range
Error location: Line 12 - where I set the targetsheet to Sheet(0).
Thank you so much for any help!
Sub SpecialCopy()
Dim targetSh, destinationSh, invSh As Worksheet
Set targetSh = Sheets(1) 'Setting initial value to Page 2 which contains assets being searched for
Set destinationSh = Sheets(2) 'Using a second one for use in the final copy statement to the destination sheet
Dim i As Long
Dim g As Long
Dim asset As String 'Using string as asset row may contain all numbers or numbers and letters
For g = 1 To Cells(Rows.Count, "A").End(xlUp).row 'Using loop to loop through values in column containing assets being searched for
Set targetSh = Sheets(1)
asset = Cells(g, 1).Value 'Setting asset to next value in Sheet 2
Set targetSh = Sheets(0) 'Not sure if I should initialize a third worksheet to use as the worksheet containing inventory, or if setting it twice in the loop would work.
For i = 1 To Cells(Rows.Count, "F").End(xlUp).row 'Looping through values in inventory to find asset
If Cells(i, 3).Value = asset Then
Range(Cells(i, 1), Cells(i, 23)).Copy Destination:=destinationSh.Range("A" & targetSh.Cells(Rows.Count, "A").End(xlUp).row + 1) 'Trying to copy the found asset, including all rows from A to W from Sheet(0) to Sheet(2)
End If
Next i
Next g
End Sub
The code can be found on Github here: https://github.com/cookchelsea/Find_and_Paste/blob/master/Master
The starting point for sheets is Sheet(1), so pointing to Sheet(0) is getting you Run-time error 9, which in this case is because you a referencing a non-existent collection (there is no Sheet(0)). More on that error code here.
this is my first post here, I know I'm articulating this poorly.
I'm trying to find cells containing a specific phrase in a column of dates. This phrase marks the beginning of a section. I then want to state the number of days elapsed from the first date in each section to other dates in the section. The values returned should show up in the adjacent column. Below is an example of the columns.
Dates and Elapsed number of days in adjacent column
I use this formula in the 2nd column:
=A15-$A$15
And then drag this down to cells in the relevant section. I'm trying to automate this process.
I found this code on this site and changed it a little bit to get this:
For Each cCell In Range("A1,A900")
cCell.Select
If ActiveCell.Value = "Phrase" Then
ActiveCell.Offset(1, 1).Value = "-"
End If
Next cCell
So my struggle is what to say in the 2nd Value field. I somehow need to get each section to subtract the first date of each section (the date right under "Phrase").
Another challenge is to copy that first adjacent cell that was changed, and then paste special into the cells below, but stopping once the next "Phrase" appears.
I'll elaborate any way I can. Thanks.
I think it's fair to say your question doesn't show much effort at solving this problem and the code snippet simply places a dash next to a "Phrase" cell. However, for a wider audience the question is interesting because it highlights the difference between automating an Excel keystroke task and writing code to process data which is then written in an Excel worksheet. Both use VBA but the former is simply a programmatic record of keystrokes and the latter is an algorithmic solution.
The telling phrase in your question is: I use this formula in the 2nd column ... and then drag this down to cells in the relevant section. I'm trying to automate this process. It would be possible to do this by using VBA to reproduce a bunch of worksheet functions but it's fiddly and could become complicated. I'll leave someone else to answer that as they'd need to spend more time on the answer than you have on the question (one of my don't do rules!).
If, on the other hand, you step away from trying to automate keystrokes and towards VBA for data processing, the problem becomes very trivial. It's a really good example of how VBA, in just a few lines, can solve problems that Excel functions might take pages to do, and probably not reliably.
So here's the code as a VBA solution. It'll need some data checking lines added to deal with blank cells, non-dates, etc. but I'll hand that task back to you:
Dim ws As Worksheet
Dim firstCell As Range
Dim lastCell As Range
Dim dataCells As Range
Dim v As Variant
Dim output() As Variant
Dim r As Long
Dim refDate As Long
'Define the range to be worked
Set ws = ThisWorkbook.Worksheets("Sheet1") 'amend as required
Set firstCell = ws.Range("A1") 'amend as required
Set lastCell = ws.Cells(ws.Rows.Count, "A").End(xlUp) 'amend as required
Set dataCells = ws.Range(firstCell, lastCell)
'Read the values and size the output array
v = dataCells.Value2 'use Value2 to avoid date format issues
ReDim output(1 To UBound(v, 1), 1 To 1)
'Loop through the values, resetting the reference date on each "Phrase"
For r = 1 To UBound(v, 1)
If v(r, 1) = "Phrase" Then
output(r, 1) = "-"
refDate = v(r + 1, 1)
Else
output(r, 1) = v(r, 1) - refDate
End If
Next
'Write output into next column
dataCells.Offset(, 1).Value = output
Hello everyone alright let start by giving some brief background on my project then I will follow up with my specific issue and code.
Currently I am building a program to automate the process of filling a template. This template exceeds 60,000 rows of data quite often and I've built the large majority of it to work month to month by plugging in new data sheets and running it. Currently all of the work is based off of one data sheet which I import into excel manually. This data sheet does not contain all the data I need to populate the template so now I am beginning to bring in additional data to supplement this. The problem herein lies with data association. When I was originally pulling from one data sheet I didn't have to worry if the data I pulled for each row coincided with the other rows because it all came from the same sheet. Now I have to cross check data across two sheets to confirm it is pulling the correct information.
Now for what you need to know. I am trying to fill a column that will be referred to as Haircut, but before I do that I need to confirm that I am pulling the correct haircut number in correlation to a Trade ID which was already populated into the template in a previous line of code.
Using similar logic that I have been using throughout my entire project this is a snippet of code I have to perform this task.
Dim anvil as Worksheet
Dim ALLCs as worksheet
Dim DS as worksheet
'''''''''''''''''''''''''''''code above this line is irrelevant to answer this question
ElseIf InStr(1, DS.Cells(x, 2), "Haircut") Then
Anvil.Select
For y = 1 To 80
If Anvil.Cells(1, y) = "Haircut" Then
For Z = 1 To 80
If Anvil.Cells(1, Z) = "Trade ID" Then
For t = 2 To 70000
For u = 16 To 70000
If Anvil.Cells(t, Z) = ALLCs.Cells(u, 34) Then
ALLCs.Cells(u, 27) = Anvil.Cells(t, y)
End If
Next
Next
End If
Next
End If
Next
This code coupled with my other code I assume will in theory work, but I can only imagine that it will take an unbelievable amount of time(this program already takes 7 and a half minutes to run). Any suggestions on how to rewrite this code with better functionality, following this general logic?
Any help is appreciated, whether you completely revamp the code, or if you offer suggestions on how to cut down loops. I am also looking for suggestions to speed up the code in general aside from screen updating and calculation suggestions.
If I understand the logic correctly then you can replace all but one of the loops with a .Find() method like so:
'// Dimension range objects for use
Dim hdHaricut As Excel.Range
Dim hdTradeID As Excel.Range
Dim foundRng As Excel.Range
With Anvil
With .Range("A1:A80") '// Range containing headers
'// Find the cell within the above range that contains a certain string, if it exists set the Range variable to be that cell.
Set hdHaircut = .Find(What:="Haircut", LookAt:=xlWhole)
Set hdTradeID = .Find(What:="Trade ID", LookAt:=xlWhole)
End With
'// Only if BOTH of the above range objects were found, will the following block be executed.
If Not hdHaricut Is Nothing And Not hdTradeID Is Nothing Then
For t = 2 To 70000
'// Using the .Column property of the hdTradeID range, we can see if the value of Cells(t, hdTradeColumn) exists
'// in the other sheet by using another .Find() method.
Set foundRng = ALLCs.Range(ALLCs.Cells(16, 34), ALLCs.Cells(70000, 34)).Find(What:=.Cells(t, hdTradeID.Column).Value, LookAt:=xlWhole)
'// If it exists, then pass that value to another cell on the same row
If Not foundRng Is Nothing Then ALLCs.Cells(foundRng.Row, 27).Value = .Cells(t, hdHaircut.Column).Value
'// Clear the foundRng variable from memory to ensure it isn't mistaken for a match in the next iteration.
Set foundRng = Nothing
Next
End If
End With
I have looked at similar answers to this question, but whatever I do I cannot get them to do what I need.
I have a daily email which has a CSV file giving call stats for our Sales team for the previous day. What I need is to put them into Excel to give trending and historical call activity for the year. Without VBA or Macros this is a very time consuming process.
The stats it gives are number of calls, and average call length (that are of any importance) I have already got VBA to calculate the total outgoing with this:
Dim Call_Number As Integer
Dim Call_Time As Date
Dim Call_Total As Date
Call_Number = .Cells(2, 6).Value
Call_Time = .Cells(2, 7).Value
Call_Total = Call_Number * Call_Time
.Cells(12, 7).Value = Call_Total
So what I need is to take the 3 cells for each sales member, and move them into the right place in their relative sheets, which are separated by name. I also need it to move into the next cell to the right if the destination cell is full, so I'm thinking I need to start the pasting process as Jan 1st and keep moving to the right until it finds blank cells. Is there a way this can be done either in a button or automatically?
I have the first sheet used as the data import sheet, where we just import the data into csv, and because its standard formatting, every day it will give it all in the right formatting.
Code I have so far. It doesn't error, but doesn't do anything:
Sub Move_Data()
Dim Dean As Worksheet
Dim Chris As Worksheet
Dim Paul As Worksheet
Dim Nigel As Worksheet
Dim Calc As Worksheet
Dim Lastrow As Long
Dim J As Long
Dim i As Long
Set Dean = ThisWorkbook.Worksheets("DEAN 822")
Set Chris = ThisWorkbook.Worksheets("CHRIS 829")
Set Paul = ThisWorkbook.Worksheets("PAULP 830")
Set Nigel = ThisWorkbook.Worksheets("NIGEL 833")
Set RUSSELL = ThisWorkbook.Worksheets("RUSSELL 835")
Set Calc = ThisWorkbook.Worksheets("Calculation Sheet")
Lastrow = Range("C" & Dean.Columns.Count).End(xlToRight).Column
J = 2
For i = 0 To Lastrow
Set Rng = Dean.Range("C5").Offset(i, 0)
If Not (IsNull(Rng) Or IsEmpty(Rng)) Then
Calc.Cells(2, 4).Copy
Dean.Range("c" & J).PasteSpecial xlPasteValues
J = J + 1
End If
Next i
Application.CutCopyMode = False
End Sub
Instead of
Lastrow = Range("C" & Dean.Columns.Count).End(xlToRight).Column
I think you want
Lastrow = Range("C" & Dean.Columns.Count).End(xlUp).Row
"I also need ... in a button or automatically?"
LastCol = WshtName.Cells(CrntRow, Columns.Count).End(xlToLeft).Column
will set LastCol to the last used column in row CrntRow.
J = 2
For i = 0 To Lastrow
Set Rng = Dean.Range("C5").Offset(i, 0)
If Not (IsNull(Rng) Or IsEmpty(Rng)) Then
Calc.Cells(2, 4).Copy
Dean.Range("c" & J).PasteSpecial xlPasteValues
J = J + 1
End If
Next i
Application.CutCopyMode = False
I am not sure what this code is attempting.
It sets Rng to C5, C6, C7, C8, ... to Cn where n is Lastrow+5. If C5, for example, if empty it copies C2 to `Calc.Cells(2, 4).
Did you mean to copy column C from worksheet Dean to column B of worksheet Calc?
If the removal of empty cells is not important then this will be faster and clearer:
Set Rng = Dean.Range(.Cells(5 ,"C"), .Cells(Lastrow ,"C"))
Rng.Copy Destination:=Calc.Cells(2, 4)
New information in response to comment
I cannot visualise either your source data or your destination data from your description so cannot give any specific advice.
Welcome to Stack Overflow. I believe this is a good place to find previously posted information and a good place to post new questions but you must follow the site rules.
Right of centre in the top bar is the Help button. Click this and read how to use this site. Learn how to post a question that will be classified as a good question and will be answered quickly and helpfully.
I believe the biggest three problems with your question are:
You ask too much. You can ask as many good questions as you wish but there should only be one issue per question.
You ask for information that is already available.
You are too vague about your requirement to permit anyone to help. You say you want to move three values per staff member. But you do not show how either the worksheet “Calculation Sheet” or the staff member worksheets are arranged. You cannot post images until you have a higher reputation but you can use the code facility to create “drawings” of the worksheets.
To avoid asking too much, you must break your requirement into small steps. The following is my attempt to identify the necessary small steps based on my guess of what you seek.
The CSV files containing staff detail arrive as attachments to a daily email. Are you manually saving those attachment? An Outlook VBA macro to save an attachment would not be difficult to write. I suggest you leave this for later but if you search Stack Overflow for “[outlook-vba] Save attachment” you will find relevant code.
The above shows how I search Stack Overflow. I start with the tag for the language and follow it with some key words or a key phrase. Sometimes it takes me a few goes to get the right search term but I rarely fail to find something interesting
How are you importing the CSV to Excel? Are you doing this manually? There are many possible VBA approaches. Try searching for “[excel-vba] xxxx” where xxxx describes your preferred approach.
I assume the structure of the CSV file is pretty simple and there is no difficulty in find information in the individual rows. You appear to know the easiest technique for finding the last row so you should have no difficulty in creating a loop that works down the rows.
How do you relate the staff member’s name in the CSV file with the name of their worksheet? In your question you have worksheet names such as "DEAN 822", "CHRIS 829" and "PAULP 830". Are these the names used in the CSV file? What happens when a new staff member joins? I doubt this happens very often but you do not want to be amending your macro when it does happen.
I do not understand your requirement for the new data to be added to the right of any existing data. There will be three values per day so with around 200 working days per year that gives 600 columns. To me that sees an awkward arrangement. I would have thought one row per day would have been more convenient.
How will you run the macro? You mention a button or automatically. I do not like buttons since I find the tool bars cluttered enough already. I prefer to use shortcut keys such as Ctrl+q. I rarely have more than one macro per workbook of this type so that works well for me. By automatically, I assume you mean the macro will run automatically when the workbook is open. I would start with the shortcut key but when you are ready look up “Events” and “Event routines”. You will find an explanation of how you can have a macro start automatically when the workbook opens.
I hope the above is of some help.
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 9 years ago.
Improve this question
I have Excel data file.
in cells I have data like this
480000074B26E42D
How can I Get result in other cell Like this
2DE4264B07000048
So, I want to take the last 2 digits and put them to front. Then the next 2 digits before the 2D and put it after the 2D(the one in front)
I try to use this code but I get wrong result
=RIGHT(B2,LEN(B2) -2)
I believe the other contributors have misunderstood your requirements & are simply offering advice to reverse the value provided.
With the input of 480000074B26E42D, I think your required outcome is incorrect: 2DE4264B07000084. The last two characters have been transposed, & the actual output will be:
2DE4264B07000048.
If that is correct, you may use this Visual Basic for Applications function (stored in a Public code module)
Public Function strReverse_Character_Pairs(ByVal strValue As String) As String
Dim lngLoop As Long
Dim strReturn As String
strReturn = ""
For lngLoop = Len(strValue) - 1& To 1& Step -2&
strReturn = strReturn & Mid$(strValue, lngLoop, 2)
Next lngLoop
strReverse_Character_Pairs = strReturn
End Function
Usage, based on the original text in cell A1, would be as follows (with this formula placed in any cell other than cell A1):
=strReverse_Character_Pairs(A1)
The function could also be enhanced to check that the value has an even number of characters by adding a "dummy" character at either end so that the reversed pairs are as intended.
I think a little vba may be the the answer, I just tested this and it works fine
Use the following function in VBA:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cells(3, 1) = StrReverse(Cells(1, 1))
End Sub
Where Cell A1 contains the string to be flipped. Cell A3 contains the result