What Im trying to do: Copy last 3 write ups from other sheets (j). The other sheets have a header, but if there are no write ups itll grab the header then error the other 2. I need it to fill the cells on the active sheet to say "No Writeups" if it trys pulling the header as a write up and stop so it doesnt error.
What I tried to do: In Cells(1,1) the header reads "Date". As K searches through column 1, I attempted to do a strComp? for the "Date" text? bc integers and strings dont compare well?
I'm getting a runtime error 1004?
Dim FirstLine As String
Dim NewestEntry As Integer
FirstLine = 6
Dim GrabbedDate As String
For j = 0 To 20 '(20) Tail Tabs/Number of Tabs
NewestEntry = Worksheets(Tail(j)).Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
For k = NewestEntry To NewestEntry - 2 Step -1
GrabbedDate = Worksheets(Tail(j)).Cells(k, 1).Text
If StrComp(GrabbedDate, "Date") = 0 Then
k = 0
If Not k = 1 Then
Worksheets(Tail(j)).Cells(k, 1).Copy Worksheets("StepBrief").Cells(FirstLine, 4) 'Date
Worksheets(Tail(j)).Cells(k, 4).Copy Worksheets("StepBrief").Cells(FirstLine, 5) 'Code
Worksheets(Tail(j)).Cells(k, 5).Copy Worksheets("StepBrief").Cells(FirstLine, 6) 'Pilot
Worksheets(Tail(j)).Cells(k, 8).Copy Worksheets("StepBrief").Cells(FirstLine, 7) 'Start Up
Worksheets(Tail(j)).Cells(k, 11).Copy Worksheets("StepBrief").Cells(FirstLine, 8) 'Airboorne
Worksheets(Tail(j)).Cells(k, 14).Copy Worksheets("StepBrief").Cells(FirstLine, 9) 'Shutdown
FirstLine = FirstLine + 1
Else
If k = 1 Then
Worksheets("StepBrief").Cells(FirstLine, 4).Value = "" 'Date
Worksheets("StepBrief").Cells(FirstLine, 5).Value = "" 'Code
Worksheets("StepBrief").Cells(FirstLine, 6).Value = "" 'Pilot
Worksheets("StepBrief").Cells(FirstLine, 7).Value = "No Write Up" 'Start Up
Worksheets("StepBrief").Cells(FirstLine, 8).Value = "No Write Up" 'Airboorne
Worksheets("StepBrief").Cells(FirstLine, 9).Value = "No Write Up" 'Shutdown
FirstLine = FirstLine + 1
End If
End If
End If
Next k
Next j
Related
I'm currently diving into code/VBA coding for the first time. I have a file that I dump into a worksheet that currently I'm manually organizing and pushing out. When put into the worksheet, it delimits itself across the cells. The first 2-4 cells are always parts of a name. This dump file will have varying row and column lengths every time I get it in a given day and dump into a work sheet. For example, one day it may be twenty rows and one day it may be thirty.
This is a rough illustration of what the data looks like, but my code probably doesn't match with the example below - I just wanted to provide a visual:
So, I'm wanting to make code that will start at A1 and concatenate the cells following it until it runs into a blank cell in that row. Then it places the concatenated data into cell A1 and removes the values it pulled the name pieces from and slides all the data to the left. After that, it continues the same operation on the next row until it meets the final row. As you can see in the image, I don't want any of the data after the blank cell to be affected.
This is my first time programming in general, so when you provide assistance, would you please explain your code so I can learn the concepts? Here's what I think will work so far... I'm just stuck on how to go about concatenating.
The code I currently have:
Sub DN_ERROR_ORGANIZER()
Dim row As Integer
NumRows = Range("A1", Range("A1").End(xldown)).Rows.Count
Range("A1").Select
For row = 1 To NumRows
Do Until IsEmpty(ActiveCell)
' Code to concatenate
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 0).Select
Next
End sub
Here's another way to look at your problem: Suppose you have your table on Sheet2, and the result is reflected on Sheet1.
Sub PutInOrder()
filledcells = 0
'''lastrow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To 100
If Sheet2.Cells(i, 1) = "" Then Exit For
For a = 1 To 4
If Sheet2.Cells(i, a) = "" Then Exit For
If Sheet2.Cells(i, a) <> "" Then
filledcells = filledcells + 1
End If
Next
Select Case filledcells
Case Is = 2
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 4)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 5)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 7)
Case Is = 3
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2) + " " + Sheet2.Cells(i, 3)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 5)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 7)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 8)
Case Is = 4
Sheet1.Cells(i, 1) = Sheet2.Cells(i, 1) + ", " + Sheet2.Cells(i, 2) + " " + Sheet2.Cells(i, 3) + " " + Sheet2.Cells(i, 4)
Sheet1.Cells(i, 3) = Sheet2.Cells(i, 6)
Sheet1.Cells(i, 4) = Sheet2.Cells(i, 7)
Sheet1.Cells(i, 5) = Sheet2.Cells(i, 8)
Sheet1.Cells(i, 6) = Sheet2.Cells(i, 9)
End Select
filledcells = 0
Next
End Sub
Can you try this and let me know how you get on? It may need some tweaks depending on your precise layout. My approach is slightly different.
Sub x()
Dim n As Long, r1 As Range, r2 As Range, v
For n = 1 To Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
Set r1 = Cells(n, 1).EntireRow.SpecialCells(xlCellTypeConstants).Areas(1)
Set r2 = Cells(n, 1).EntireRow.SpecialCells(xlCellTypeConstants).Areas(2)
If Not r1 Is Nothing And Not r2 Is Nothing Then
v = Join(Application.Transpose(Application.Transpose(r1)), ", ")
Cells(n, 1) = WorksheetFunction.Proper(v)
Cells(n, 2).Resize(, r1.Count).Clear
r2.Cut Cells(n, 3)
End If
Next n
End Sub
I have this simple data set:
230
16000
230
230000
230000
230000
16000000
230000
230000
all i want is to get the length of each cell but when i write this code:
Sub LengthOfCell()
Dim c As Long
Dim result As Integer
c = ActiveCell.Value
result = Len(c)
Debug.Print (result)
End Sub
it gives me 2 for the first cell (230) when it should be 3 and 4 for any number having more than 3 digits. dont know what i am doing wrong. tis is just for proof of concept for a larger SUB:
Public Sub SortMyData()
'approach: convert line to string and concatenate to that as it's a lot less picky than Excel's formats, then replace cell value with the new string.
' Excel will then define the string type as either Percentage or Scientific depending on the magnitude.
Dim i As Integer
Dim N_Values As Integer
N_Values = Cells(Rows.Count, 2).End(xlUp).Row
'Range("B6", Range("B5").End(xlDown)).Count
For i = 6 To N_Values 'iteration loop from 6 (first row of value) to N_Values (last filled row)
Cells(i, 3).NumberFormat = "0"
If Cells(i, 2).NumberFormat <> "0.0%" Then
Cells(i, 2).NumberFormat = "0.0%"
Cells(i, 2).Value = Cells(i, 2).Value / 100
ElseIf Len(Cells(i, 3).Value > 3) Then
Cells(i, 3).Value = Cells(i, 3).Value / 1000
ElseIf Cells(i, 3).Value = Null Then
Cells(i, 3).Value = 0
Else
Cells(i, 2).Value
Cells(i, 3).Value
End If
' If Len(Cells(i, 3) > 3) Then
' Cells(i, 3).Value = Cells(i, 3).Value / 1000
' ElseIf Cells(i, 3).Value = Null Then
'Cells(1, 3).Value = 0
' Else
' Debug.Print
' End If
Next
End Sub
The closing ) is in the wrong place.
If Len(Cells(i, 3).Value > 3) Then
should be
If Len(Cells(i, 3).Value) > 3 Then
Len(Cells(i, 3).Value > 3) will evaluate to Len("True") or Len("False"), so it will always be True (any non-zero number is True)
Len is a String type function
#Shai Rado, please, be careful with such statements in answers for newbies...
F1: Len Function
Returns a Long containing the number of characters in a
string or the number of bytes required to store a variable.
Not sure why you're including the Dim c As Long piece at all - why not try this:
Sub LengthOfCell()
Dim result As Integer
result = Len(ActiveCell.Value)
Debug.Print (result)
End Sub
That works fine for me..
Since you are looking for the number of characters (digits) in the cell, you need to change to Dim c As String and modify your code a little, it will give you the Result that you are looking for.
See short-sub below:
Sub LengthOfCell()
Dim c As String
Dim i As Long
Dim result As Integer
For i = 1 To 9
c = CStr(Cells(i, 1).Value)
result = Len(c)
Debug.Print result
Next i
End Sub
There seems to be a confusion between Value and Display Text. Range().Value will return the ranges raw value, where as, Range().Text or Cstr(Range().Value) will return the formatted value.
Sub Demo()
Dim r As Range
For Each r In Range("A2:A9")
r.Value = 230
r.Offset(0, 1) = r.NumberFormat
r.Offset(0, 2) = Len(r.Value)
r.Offset(0, 3) = Len(r.Text)
r.Offset(0, 4) = Len(CStr(r.Value))
Next
End Sub
I'm exporting my data from MS Project to MS Excel (single pre-defined file with a given name all the time, for e.g. XYZ.xlsx) and want to have different worksheet in the excel for every workstream in the project. And number of workstreams can increase in future, thus I've to keep it dynamic.
As of now my code does the export, but I also want it to check if the workstream already exists,
- if yes, delete all the data in that worksheet and paste the new data in XYZ file.
- if no, create a new worksheet in the XYZ file and paste the data into it.
Can anyone please help as I'm on a deadline to finish it.
Code that I'm using it,
Set tsks = ThisProject.Tasks
For Each t In tsks
If Not t Is Nothing Then
If t.OutlineLevel > 1 Then
If t.OutlineLevel = 2 Then
If ExcelRowCounter > 2 Then
'Finish formatting the sheet we just finished
For i = 1 To 7
xlSheet.Columns(i).AutoFit
Next i
End If
'Add Excel sheet, name it and define column headers
AppActivate ExcelAppTitle
Set xlSheet = xlBook.Worksheets.Add
ExcelSheetName = Left(Replace(t.Name, "&", "and"), 30)
xlSheet.Name = ExcelSheetName
xlSheet.Cells(1, 1).Value = "Task Name"
xlSheet.Cells(1, 2).Value = "Duration (days)"
xlSheet.Cells(1, 3).Value = "Start Date"
xlSheet.Cells(1, 4).Value = "Finish Date"
xlSheet.Cells(1, 5).Value = "Workstream Group"
xlSheet.Cells(1, 6).Value = "% Complete"
xlSheet.Cells(1, 7).Value = "Status"
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 7)).Font.Bold = True
ExcelRowCounter = 2
End If
xlSheet.Cells(ExcelRowCounter, 1).Value = t.Name
xlSheet.Cells(ExcelRowCounter, 2).Value = t.Duration / (8 * 60)
xlSheet.Cells(ExcelRowCounter, 3).Value = Format(t.Start, "mm/dd/yyyy")
xlSheet.Cells(ExcelRowCounter, 4).Value = Format(t.Finish, "mm/dd/yyyy")
xlSheet.Cells(ExcelRowCounter, 5).Value = t.Text1
xlSheet.Cells(ExcelRowCounter, 6).Value = t.PercentComplete
xlSheet.Cells(ExcelRowCounter, 7).Value = t.Number1
xlSheet.Cells(ExcelRowCounter, 1).IndentLevel = 2 * (t.OutlineLevel - 2)
If t.Summary = "True" Then
xlSheet.Range(xlSheet.Cells(ExcelRowCounter, 1), xlSheet.Cells(ExcelRowCounter, 6)).Font.Bold = True
End If
ExcelRowCounter = ExcelRowCounter + 1
End If
End If
Next t
For i = 1 To 7
xlSheet.Columns(i).AutoFit
Next i
Here's as simple method:
Function AddOrGetWorksheet(withName As String) As Worksheet
Dim found As Boolean
found = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
If (LCase(ws.Name) = LCase(withName)) Then
found = True
Set AddOrGetWorksheet = ws
Exit For
End If
Next
If (Not found) Then
Set AddOrGetWorksheet = ActiveWorkbook.Sheets.Add()
AddOrGetWorksheet.Name = withName
End If
End Function
So I have 4 sheets that are called "old", "current", "input", and "buttons". The process is to: press a button on the "buttons" sheet to clear the "current" sheet and "input" sheet, paste data onto the "input" sheet and press a macro button on the "buttons" sheet to populate the "current" sheet. Most of the macro will be formatting the "current" sheet and using index match for data from the "old" sheet. What I'm trying to do is add a step in the beginning to clear the "old" sheet and then copy and paste the data from the "current" sheet onto the "old" sheet. The reason is that I will be using this weekly and every time I run the macro, I want the "current" sheet, that was created last time I ran the macro, to move to the "old" sheet. This is currently the code that I have...
Sub Load16()
Application.ScreenUpdating = False
'Define Workbooks
Dim loopCount As Integer
Dim loopEnd As Integer
Dim writeCol As Integer
Dim matchRow As Integer
Dim writeRow As Integer
Dim writeEnd As Integer
loopEnd = WorksheetFunction.CountA(Worksheets("Input").Range("A:A"))
writeEnd = WorksheetFunction.CountIf(Worksheets("Input").Range("L:L"), "-1")
loopCount = 1
writeRow = 1
Worksheets("Buttons").Range("F17:I17").Copy
Worksheets("Current").Range("J2:M" & writeEnd).PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
Do While loopCount <= loopEnd
If Worksheets("Input").Cells(loopCount, 12).Value <> "" And
Worksheets("Input").Cells(loopCount, 12).Value <> 0 Then
Worksheets("Current").Cells(writeRow, 1).Value = Worksheets("Input").Cells(loopCount, 26).Value
writeCol = 2
Do While writeCol <= 9
Worksheets("Current").Cells(writeRow, writeCol).Value = Worksheets("Input").Cells(loopCount, writeCol - 1)
writeCol = writeCol + 1
Loop
writeCol = 14
Do While writeCol <= 30
Worksheets("Current").Cells(writeRow, writeCol).Value = Worksheets("Input").Cells(loopCount, writeCol - 5)
writeCol = writeCol + 1
Loop
Worksheets("Current").Cells(writeRow, 31).Value = Worksheets("Input").Cells(loopCount, 27)
writeRow = writeRow + 1
Else
End If
loopCount = loopCount + 1
Loop
Worksheets("Current").Range("J1").Value = "Counsel"
Worksheets("Current").Range("K1").Value = "Background"
Worksheets("Current").Range("L1").Value = "Comments"
Worksheets("Current").Range("M1").Value = "BM Action"
Lookup Data for K - M and a few other things
loopCount = 2
Do While loopCount <= loopEnd
matchRow = 0
On Error Resume Next
matchRow = WorksheetFunction.Match(Worksheets("Current").Cells(loopCount, 1).Value, _
Worksheets("Old").Range("A:A"), 0)
If matchRow = 0 Then
Else
Worksheets("Current").Cells(loopCount, 11).Value = Worksheets("Old").Cells(matchRow, 11).Value
Worksheets("Current").Cells(loopCount, 12).Value = Worksheets("Old").Cells(matchRow, 12).Value
Worksheets("Current").Cells(loopCount, 13).Value = Worksheets("Old").Cells(matchRow, 13).Value
End If
Worksheets("Current").Cells(loopCount, 10).Value =
Worksheets("Current").Cells(loopCount, 18).Value
loopCount = loopCount + 1
Loop
Sheets("Current").Range("A2:AE" & loopEnd).Sort Key1:=Sheets("Current").Range("H2"), _
Order1:=xlAscending, Header:=xlNo
Worksheets("Current").Columns("A:BZ").AutoFit
Application.ScreenUpdating = True
Worksheets("Buttons").Select
MsgBox loopEnd - 1 & " Rows processed. " & writeEnd & " Rows remain."
End Sub
Thanks guys.
A small function like this should do the trick.
Sub copy_current_data()
'Select Old Sheet
Sheets("Old").Select
'Clear all cells from Old Sheet
Sheets("Old").Cells.ClearContents
'Copy Cells from Current Sheet
Sheets("Current").Cells.Copy
'Select "A1" in old sheet
Sheets("Old").Range("A1").Select
'Paste Data
ActiveSheet.Paste
End Sub
I modified a script to cut a big chunck of data into small pieces to keep subscript in the range.
I suppose to import data into spreadsheet, but it says
Run-time error '9':
Subscript out of range
Code
Private Sub btnRefresh_Click()
Dim W As Worksheet: Set W = ActiveSheet
Dim Last As Integer: Last = W.Range("b2000").End(xlUp).Row
Dim Last1 As Integer
Dim Symbols As String
Dim i, n, x, y As Integer
Last1 = Last - CInt(Last / 10) * 9
x = 5
For n = Last1 To Last Step CInt(Last / 10)
For i = x To n
Symbols = Symbols & W.Range("b" & i).Value & "+"
Next i
x = i
'Stop
Symbols = Left(Symbols, Len(Symbols) - 1)
Debug.Print Symbols
'Stop
Dim URL As String: URL = "http://finance.yahoo.com/d/quotes.csv?s=" & Symbols & "&f=snxl1c7g0h0" & Cells(2, 11) & "j0k0va2j1e7rs7dy"
Dim Http As New WinHttpRequest
Http.Open "GET", URL, False
Http.Send
Dim Resp As String: Resp = Http.ResponseText
Dim Lines As Variant: Lines = Split(Resp, vbNewLine)
Dim sLine As String
y = 5
For i = y To n
sLine = Lines(i)
Debug.Print sLine
'Stop
If InStr(sLine, ",") > 0 Then
Values = Split(sLine, ",")
W.Cells(i, 3).Value = Split(Split(sLine, Chr(34) & "," & Chr(34))(1), Chr(34))(0)
W.Cells(i, 4).Value = Split(Split(sLine, Chr(34) & "," & Chr(34))(2), Chr(34))(0)
W.Cells(i, 5).Value = Values(UBound(Values) - 14)
W.Cells(i, 6).Value = Values(UBound(Values) - 13)
W.Cells(i, 7).Value = Values(UBound(Values) - 12)
W.Cells(i, 8).Value = Values(UBound(Values) - 11)
W.Cells(i, 9).Value = Values(UBound(Values) - 10)
W.Cells(i, 10).Value = Values(UBound(Values) - 9)
W.Cells(i, 11).Value = Values(UBound(Values) - 8)
W.Cells(i, 12).Value = Values(UBound(Values) - 7)
W.Cells(i, 13).Value = Values(UBound(Values) - 6)
W.Cells(i, 14).Value = Values(UBound(Values) - 5)
W.Cells(i, 15).Value = Values(UBound(Values) - 4)
W.Cells(i, 16).Value = Values(UBound(Values) - 3)
W.Cells(i, 17).Value = Values(UBound(Values) - 2)
W.Cells(i, 18).Value = Values(UBound(Values) - 1)
W.Cells(i, 19).Value = Values(UBound(Values))
End If
Next i
Symbols = ""
Next n
W.Cells.Columns.AutoFit
End Sub
First off, make sure you have
Option Explicit
at the top of your code so you can make sure you don't mess any of your variables up.
Subscript out of range means that the program declares (DIM) an array to be of a certain length, but tries to reference an element with a subscript greater than the actual length. Often, but not always, this happens because a loop goes one index too far. Another common cause is using an index that has never been assigned a valid value.